//	COPYRIGHT (C) 1981 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

/* 
			GLBLD

	CONSTRUCTIVE GRAPH MATCHING STRUCTURE GENERATOR

R.L. CARHART 1979
modified by N.A.B.G. 1980



	This code incorporates both the constructive graph matching
procedures and a simple structure generator. The constructive graph matching
procedures take, as input, a new constraint defining a substructure
that must be built and map this on to each existing "CASE" in all
possible ways to derive new cases. The generator just works through
all existing cases finding ways of assigning any remaining bonds in
order to derive final complete structures.



	Several mods as compared with standard Carhart version
include hybridization tags, "colouring" of atoms, scores.




ADDITIONS PROVIDE FOR USER INTERRUPTS TO DRAW STRUCTURES, ABORT PROCESSING
ETC.

*/
$LIBRARY "BCPLIB.REL[1,202]"
$NOLIST
GET "BCPLIB.GET"
GET "ACS.GET[1,202]"
GET "MYLIB.GET"

EXTERNAL $( DRAW $)
$LIST

STATIC $( VECSPACE = VEC 20000; STACK = VEC 2500; STACKPTR = 0 $);
LET DOSTUFF() BE $(DOS
MANIFEST $( 
ALLENE  = 8			// value for sp1b (allene/ketene type hybridization) in HYBRITYPE
ALKYNE  = 4			// value for sp1a (alkyne/nitrile type hybridization)
ANYBSYM = #174;			// another special character in structure files
AROMATIC = 2;			// value of "AROMATIC" in ARTYPE bit pattern
ARSYM = #175; 			// Special character used as tag in structure files etc (designates aromatic character)
BLKSIZE = #200; 		// Size of one block in random access file 
CFMAX = 1000;
CGPNDSYM = #174 		// another special character in structure files 
CHUNKSEP = 12; 			// (Page throw character) used in "segmented files" like TOP file
DBTYPE  = 10			// corresponds to sp1b or sp2 in HYBRIDTYPE (i.e. types with double bonds)
ESSEP = 9;			// (Tab character) also used in things like TOPFILE
GSIZE0 = 1000;			// Size of array allowed for symmetry groups.
KEYROT = 7;			// shift necessary to move one character round
 NOTAROM = 1;			// bit for non-aromatic in ARTYPE
P2WDSZ = 5; 			// 2^p2wdsz bits in word when word used as bit map (i.e. 32 bits of words used in bit maps)
RANIOCHAN = 6;			// JFN/equivalent for random-access file
ROWTERM = #177; 		// Mask
R2WDSZ = 32; 			// r2wds=2^p2wdsz
SP1A	= 4
SP1B	= 8
SP2    = 2			// value for SP2 type hybride in HYBRIDTYPE
SP3    = 1			// value for SP3 type hybride in HYBRIDTYPE
SSSIZE = 5000; 			// Size of table with keys for canonical structures
SYMMASK = #177; 		// Mask
SYMSIZE = 7; 			// Number of bits/character 
SYMSPERWD = 5; 			// Number of characters/word
$);
STATIC $( 
ABANDONED	= FALSE
ANYCN 		= NIL; 
ARTYPE 		= NIL 
AROMWARN	= NIL
ATI 		= NIL;
ATTYPE		= NIL;
ATFREQ		= NIL;
BLEACH		= NIL; // Mode switch, indicates pass through structures removing color tags.
BLOCKCOUNT 	= NIL;
BOSCRATCH 	= NIL; 
CEN1 		= NIL; 
CEN2 		= NIL; 
CGPNUMBERING 	= NIL; 
CGPNUMBINV 	= NIL; 
CN 		= NIL; 
CGPATPROPS 	= NIL; 
CGPSTART	= 1; 
CGPSTOP		= NIL;
COMPOFFSET 	= NIL;
COMPONENTID	= NIL;
COMPS 		= NIL;
CTABLE		= NIL; 
CTPTR 		= 1;
CTSTART		= NIL; 
CTSTOP		= NIL; 
CURRENTPATREC 	= NIL;
DEPTHRECUR 	= 0;
EBPTR 		= NIL; 
LASTBLOCK 	= VEC BLKSIZE-1; 
FILIXLIST 	= VEC SSSIZE;
FGLN 		= NIL; 
FGLNLIM 	= NIL;
FGLNSAV		= VEC 100
FGLNLEV		=0
FIRSTBUILTMATCH = NIL; 
FIRSTCONSTRAINT  = NIL;
FIRSTPATNAME 	= NIL; 
GENERATING 	= NIL;
GLITABLE 	= NIL; 
GSCRATCH 	= VEC GSIZE0; 
HCOUNT 		= NIL; 
HMAX 		= NIL; 
HMAX2 		= NIL;
HMIN		= NIL; 
HYBRIDTYPE 	= NIL;
INFILE 		= NIL;
INSOURCE 	= NIL;
ISOLATD 	= NIL;
ISTRUC 		= NIL;
KEYLIST 	= VEC SSSIZE; 
KEYSTR		= NIL;
KFSTART 	= NIL; 
MAPPEDTO 	= NIL;
MATCHES 	= NIL; 
MAXMATCH 	= NIL; 
MCHSIZ 		= NIL;
MIDBLOCK 	= VEC BLKSIZE-1; 
MINGENERATESCORE = NIL
MODABONDS 	= VEC 25;
MODABPTR 	= NIL; 
MODE 		= NIL; 
NCE 		= NIL; 
NCGPNDS 	= NIL;
NCN 		= NIL;
NCOMP 		= NIL;
NDFREEV 	= NIL;
NDIX 		= NIL;
NEWBELIEF 	= NIL;
NEWDISBELIEF 	= NIL;
NEWBONDS 	= VEC 25; 
NEWBPTR         = NIL; 
NMATCH 		= NIL; 
NNODES		= NIL; 
NOBUILD 	= NIL;
NPATNODES 	= NIL; 
NSTRUCS 	= NIL; 
NTOTB 		= NIL; 
NTOTHMAX 	= NIL; 
NTOTHMIN 	= NIL; 
NTOTM 		= NIL; 
NTYPES		= NIL; 		// Number of different atom types
NUMPAT 		= NIL; 
OLDBELIEF 	= NIL; 
OLDDISBELIEF 	= NIL;
OUTFILE 	= NIL; 
PARENTCOMP 	= NIL; 
PATMAXS 	= NIL; 
PATMINS 	= NIL; 
PATNNDS 	= NIL; 
PATREC 		= NIL; 
PATRECS 	= NIL; 
PATSCORES 	= NIL;
PATSTART 	= NIL; 
PATSTOP 	= NIL; 
REDHMAX 	= NIL;
SAREC 		= NIL;
SPECIALPATS 	= NIL; 
STACKBOTTOM 	= NIL; 
STREXISTS 	= NIL; 
STRUCNUMBER 	= NIL; 
STRUCSZ 	= NIL; 
STRUCSZ0 	= NIL;
SUBSCORES       = NIL;
SYMLIM 		= NIL; 
TEMPARS		= NIL;
TEMPHYBS	= NIL;
TOPEXISTS 	= NIL; 
TOTB 		= NIL; 
TOTB0 		= NIL; 
TOTCOMPHMAX 	= NIL;
TOTHMAX 	= NIL; 
TOTHMIN 	= NIL;
TOTM 		= NIL; 
TYPENAME	= NIL; 		// Vector of strings giving atom names
TYPENUM    	= NIL; 
TYPEVALENCE	= NIL; 	// Vector holding atom valences
U		= NIL; 
UMARKS 		= NIL 
$);


static $( BUGON = FALSE $)
static $( COUNTFORMBONDS = NIL; 
COUNTFINDBONDS = NIL;
COUNTFIND1 = NIL;
COUNTUNIQUECGP = NIL;
COUNTPROCGLIMATCH = NIL 
$)
let bugcall(str) be $(
  if BUGON then  OUTS(str)
  $)


let BUGTABLES(N,S,F) be $(bt
 /* This function is of some value when debugging with BCPLDT, it
 allows printing out of selected tables. */
 static $( PTR = NIL; PTRTOP = NIL $)
 switchon N into $(sw
  case 1: OUTS("*C*L Node   CTSTART  CTSTOP*C*L")
	for I=S to F do $( OUTNON(I,5); OUTNON(CTSTART!I,9); OUTNON(CTSTOP!I,8); NEWLINE(1) $)
	endcase;
  case 2: OUTS("*C*L Node CTABLE---*C*L");
	for I=s to F do $(
	   OUTNON(I,5); SPACES(2); PTR:=CTSTART!I-1; PTRTOP:=CTSTOP!I;
	   while PTR<PTRTOP do $( PTR+:=1; OUTNOS(CTABLE!PTR) $)
	   NEWLINE(1)
	   $)
	endcase;
  case 3: OUTS("*C*L Node ARTYPE HMIN HMAX HYBRIDTYPE UMARKS*C*L");
	for I=S to F do $( OUTNON(I,5); 
		OUTNON(ARTYPE!I,7); OUTNON(HMIN!I,5); 
	        OUTNON(HMAX!I,5); OUTNON(HYBRIDTYPE!I,11); 
		OUTNON(UMARKS!I,11); NEWLINE(1) $)
	endcase;
  default:
  $)sw

$)bt


LET SHOWGROUP(GROUP,NNODES) be $(shgrp
 static $( GROUPSZ = NIL; PTR = NIL $)
 OUTS("Symmetry group data:*C*L")
 GROUPSZ:=GROUP!0;
 PTR:=1
 for g=1 to GROUPSZ do $(
     OUTS("Permutation : "); OUTNOS(g); OUTS("(disabled level "); 
     OUTNOS(GROUP!PTR); OUTS(")*C*L");
     PTR+:=1;
     for n=1 to NNODES do $(
       OUTNOS(GROUP!PTR); PTR+:=1
       $)
     NEWLINE(1)
     $)
$)shgrp

LET BUGSYMTABLES(COMPS,GROUPTOO) BE $(SYMTAB
/* NEED PRINT OUT OF SYMMETRY GROUP ETC. */
 STATIC $( ATVEC = NIL; COMPREC = NIL; NCOMP = NIL; NUMATS = NIL $)
 OUTS("COMPS RECORD:*C*L");
 NCOMP:=COMPS!0
 for N=1 to NCOMP do $(compn
    OUTS("Component "); OUTNOS(N);
    COMPREC:=COMPS!N
    test COMPREC!1 then OUTS("representative component*C*L")
    or OUTS("not representative component*C*L")
    OUTS("(data in link field COMPREC!2 : "); OUTNO(COMPREC!2); OUTS(")*C*L")
    ATVEC:=COMPREC!0; NUMATS:=ATVEC!0;
    OUTS("This component has "); OUTNOS(NUMATS); OUTS("constituent atoms.*C*L");
    OUTS("Atoms, in canonical order are : ");
    for nn=1 to NUMATS do OUTNOS(ATVEC!nn); NEWLINE(1)
    if GROUPTOO then SHOWGROUP(COMPREC!4,NUMATS)
    NEWLINE(1)
    $)compn

$)SYMTAB


static $( COLLISIONCOUNT = NIL; PAGING = NIL $)

let PAGEREPORT() be $(
//   OUTS("*C*LCollision count : "); OUTNOL(COLLISIONCOUNT)
//   OUTS("*C*LPage calls     : "); OUTNOL(PAGING)
RETURN
$)


STATIC $( TIMINGS = VEC 20 $)
MANIFEST $( TIMEGM = 0; TIMEGL = 1; TIMETPMX = 2; TIMEPRCGLI = 3;
  TIMECANONCOMPS = 4; TIMEUNIQUE = 5 $)

let REPORTTIMINGS() be $(

//   OUTS("*C*LCOUNTS FOR VARIOUS ROUTINES.*C*L*L")
//   OUTS("PROCGLIMATCH           : "); OUTNOL(COUNTPROCGLIMATCH)
//   OUTS("UNIQUECGP              : "); OUTNOL(COUNTUNIQUECGP)
//   OUTS("FIND1                  : "); OUTNOL(COUNTFIND1)
//   OUTS("FINDBONDS              : "); OUTNOL(COUNTFINDBONDS)
//   OUTS("FORMBONDS              : "); OUTNOL(COUNTFORMBONDS)

//   OUTS("Time spent graph matching : "); OUTNOL(TIMINGS!TIMEGM);
//   OUTS("Time spent GLstepping     : "); OUTNOL(TIMINGS!TIMEGL);
//   OUTS("Time spent Pat Max test   : "); OUTNOL(TIMINGS!TIMETPMX);
//   OUTS("Time spent Proc Gli Match : "); OUTNOL(TIMINGS!TIMEPRCGLI);
//   OUTS("Time spent CANONCOMPS     : "); OUTNOL(TIMINGS!TIMECANONCOMPS);
//   OUTS("Time spent Uniquecgp      : "); OUTNOL(TIMINGS!TIMEUNIQUE);
//   NEWLINE(1)
RETURN
$)


 
 LET DRAWMAIN() BE $(ESD
  STATIC $( NDNUM = NIL; HIGHNODE = NIL; NNODES = NIL; 
               TOOCROWDED = NIL; OOUT = NIL $);
 
 STATIC $( 
TRANS = VEC 100;
DRAWNAT = VEC 50;
USEDAT = VEC 50;
NAMES2 = VEC 500; 
NAMES = VEC 500;
ICON = VEC 500
ICON2 = VEC 300 
TEMP = VEC 50
NUMAT = NIL; 
NUM2 = NIL
NBRCOUNT = vec 50 $)
MANIFEST $( MOSTCROWDED = 6; MOSTNODES = 50 $);
 
 
 LET NEXTONE() = VALOF $(NXT
  /* HAVE TO FIND THE NEXT BIT OF CONNECTED STRUCTURE NOT YET DRAWN. */
  STATIC $( NUM = 0; STRT = 0 $)
 
  let EXPLORE(ND) be $(
    LET NCH,PTR,NDX = NIL,NIL,NIL 
    /* Walk through connected bit of graph, storing atom node numbers
    temporarily in TEMP,
    */

    if DRAWNAT!ND then return
    DRAWNAT!ND:=TRUE
    NUM+:=1;
    TRANS!ND:=NUM
    TEMP!NUM:=ND
    PTR:=((ND-1)<<2)+1
    NDX:=((NUM-1)<<2)+1
    NCH:=NAMES2!PTR
    NAMES!NDX:=NCH
    for N=1 to NCH do NAMES!(NDX+N):=NAMES2!(PTR+N)
    PTR:=(ND-1)*6+1; 
    for N=1 to NBRCOUNT!ND do $( EXPLORE(ICON2!PTR); PTR+:=1 $)
    
   $)
 
  let FILLCT(N) be $(
    static $( ND = NIL; NBR = NIL; NBRNUM = NIL; NDNUM = NIL; PTR = NIL; PTR2 = NIL $)
 
    for I=0 to 300 do ICON!I:=0;
    for I=1 to N do $(
 	
 	ND:=TEMP!I
 	NDNUM:=I; PTR:=(NDNUM-1)*6+1; PTR2:=(ND-1)*6+1;
 	for N=1 to NBRCOUNT!ND do $( NBR:=ICON2!PTR2; 
 		NBRNUM:=TRANS!NBR
		ICON!PTR:=NBRNUM
 		PTR+:=1; PTR2+:=1 
 		$)
 	
 	$)
   $)
 
  STRT:=1;
  $( IF USEDAT!STRT & (NOT (DRAWNAT!STRT)) THEN BREAK
     STRT+:=1; 
  $) REPEATUNTIL STRT GR MOSTNODES
  if STRT GR MOSTNODES then resultis 0
 
  /* Have found some atoms not yet drawn; first being that with index
  STRT. Now in effect must walk through graph, finding all neighbours
  and neighbours of neighbours etc.
  */
  NUM:=0
  EXPLORE(STRT)
  FILLCT(NUM)
  resultis NUM
  $)NXT
 
 
  let PUTNAME(NODE,STR) be $(ptnm
   static $( IDUM = NIL; INJ = NIL; J = NIL; NCHAR = NIL; STRSP = vec 50 $)
   IDUM:=1+([NODE-1]<<2)
   NCHAR:=NCHARS(STR)
   if NCHAR>3 then NCHAR:=3
   UNPACKSTRING(STR,STRSP)
   J:=0;
   WHILE J<NCHAR DO
    $(
    J+:=1;
    INJ:=STRSP!J
    NAMES2![J+IDUM]:=INJ
    $);
   NAMES2!IDUM:=NCHAR
 
  $)ptnm
 
 
 
 
  let PUTNBRNODE(NBR,NODE) be $(PNBRND
    static $( NDX = NIL $)
    NBRCOUNT!NODE+:=1
    NDX:=NBRCOUNT!NODE+(NODE-1)*6
    ICON2!NDX:=NBR
    $)PNBRND
 
 
 
 
  LET CTESCAN(CTE) BE
   $( STATIC $( ATNAME = NIL; NBR = NIL; PTR = NIL; PTRTOP = NIL $);
 
 
   ATNAME:=TYPENAME!(ATTYPE!CTE)
   USEDAT!CTE:=TRUE
   PUTNAME(CTE,ATNAME)
   PTR:=CTSTART!CTE-1
   PTRTOP:=CTSTOP!CTE
   while PTR < PTRTOP do
	    $(NBRS
	    PTR+:=1
	    NBR:=ABS (CTABLE!PTR)
	    UNLESS NBR=0 DO PUTNBRNODE(NBR,CTE)
	    $)NBRS
   $);
 
 
 
  NNODES:=CGPSTOP-CGPSTART+1;
  HIGHNODE:=0;
  TOOCROWDED:=FALSE;
  for ND=CGPSTOP to CGPSTART do
     if (CTSTOP!ND-CTSTART!ND) > MOSTCROWDED then TOOCROWDED:=TRUE
  IF NNODES>MOSTNODES DO
   $(
   OUTS("#"); OUTNOL(NSTRUCS)		
   OUTS("*C*LCAN'T DRAW - MORE THAN ");
   OUTNOS(MOSTNODES);
   OUTS("ATOMS AND ATOM-LIKE SYMBOLS*C*L");
   RETURN
   $);
  IF TOOCROWDED DO
   $(
   OUTS("#"); OUTNOL(NSTRUCS)
   OUTS("*C*LCAN'T DRAW - SOME ATOM IS TOO CROWDED*C*L");
   RETURN
   $)
  for I=1 to 300 do ICON!I,ICON2!I:=0,0
  for I=1 to 50 do USEDAT!I,DRAWNAT!I,NBRCOUNT!I:=FALSE,FALSE,0;

  for CTE=CGPSTART to CGPSTOP do CTESCAN(CTE);


  OUTS("*C*L#"); OUTNOL(NSTRUCS)
  $(RPT
  NUM2:=NEXTONE()
 
  IF NUM2=0 THEN BREAK
  TEST NUM2>1 THEN DRAW(ICON,NUM2,NAMES)
  OR
   FOR I=1 TO (NAMES!1+1)
               DO  OUTCH(NAMES!(1+I))
  NEWLINE(2)
  $)RPT REPEAT
  RETURN
$)ESD


LET TTYCHK() = VALOF $(TTYX
 $[ $SETZ AC,0
    $TTCALL 11,0
    $( RETURN $)
    $SETO AC,0
 $]
$)TTYX


let CHECKUSERCONTROL(JUSTGEN) be $(
 static $( OIN = NIL; CH = NIL $)
 OIN:=INPUT
 INPUT:=TTY
 unless TTYCHK() do $( INPUT:=OIN; return $)
 CH:=INCH()
 switchon CH into $(sw
   case 'a': case 'A': 
	     unless ABANDONED | (NOT JUSTGEN) do $(
		OUTS("*C*L*LI will stop processing when I have completed*C*L")
		OUTS("the CASE most recently read in.*C*L")
                $)
	     ABANDONED:=TRUE
	     endcase;
   case 's': case 'S':
	        OUTS("*C*LCurrently working on input CASE #"); OUTNOL(STRUCNUMBER)
		OUTS("Have created "); OUTNOS(NSTRUCS); OUTS("resulting CASES.*C*L")
		endcase;
   case 'd': case 'D':
		if JUSTGEN then DRAWMAIN()
		endcase;
   default:
  $)sw
 while TTYCHK() do INCH()
 INPUT:=OIN
 NEWLINE(1)
 TERMPOSITION:=0
 return
$)

$NOLIST
//            SET-MANIPULATION FUNCTIONS.  
// SETS ARE BIT PATTERNS CONTAINED IN VECTORS.  
// THERE ARE R2WDSZ BITS STORED IN EACH
//VECTOR LOCATION AND NSETWDSM1 IS ONE LESS THAN THE NUMBER OF
//WORDS NEEDED TO REPRESENT THE SET (IE, NSETWDSM1 IS COMPUTED BY
//(HIGHEST SET ELEMENT)>>P2WDSZ).  IT IS THE CALLERS RESPONSIBILITY
//TO SET NSETWDSM1, AND TO RESTORE IT TO ITS OLD VALUE WHEN DONE WITH
//THE SET FUNCTIONS.
  STATIC $( NSETWDSM1 = NIL $);

  LET SETSIZE(SET) = VALOF $(stsz
   STATIC $( FOURBITSZ = TABLE 0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4;
              PARTSET = NIL; COUNT = NIL $);
   COUNT:=0;
   FOR SETI=SET TO SET+NSETWDSM1 DO
    $(forseti
    PARTSET:=!SETI;
    UNTIL PARTSET=0 DO
     $(
     COUNT+:=FOURBITSZ![PARTSET BITAND #17];
     PARTSET:=PARTSET>>4
     $)
    $)forseti;
   RESULTIS COUNT
   $)stsz;

  LET NTHELEM(N,SET) = VALOF
   TEST SETSIZE(SET)<N THEN RESULTIS PLUSINF
   OR $(nthlm
    STATIC $( ELEM = NIL; PARTSET = NIL; NEL = NIL;
                 ETOP = 1<<[R2WDSZ-1] $);
    IF N=0 DO RESULTIS -1;
    ELEM:=1;
    PARTSET:=!SET;
    NEL:=0;
    $(
    IF [PARTSET BITAND ELEM] NE 0 DO TEST N>1 THEN N-:=1 OR RESULTIS NEL;
    NEL+:=1;
    TEST ELEM=ETOP THEN $( SET+:=1; PARTSET:=!SET; ELEM:=1 $)
    OR ELEM:=ELEM<<1;
    $) REPEAT
    $)nthlm;

  LET LOWELEM(SET) = VALOF $(lwlm
   STATIC $( RIGHTBIT = TABLE 0,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0;
              ELEM = NIL; PARTSET = NIL $);
   ELEM:=0;
   FOR SETI=SET TO SET+NSETWDSM1 DO
    TEST !SETI=0 THEN ELEM+:=R2WDSZ
    OR
     $(
     PARTSET:=!SETI;
     $(
     TEST [PARTSET BITAND #17]=0 THEN ELEM+:=4
     OR RESULTIS ELEM+RIGHTBIT![PARTSET BITAND #17];
     PARTSET:=PARTSET>>4
     $) REPEAT
     $);
   RESULTIS -1
   $)lwlm;

  LET MAKESET() = NEWVEC(NSETWDSM1);

  LET FREESET(SET) BE FREEVEC(SET);

  LET SETEQUAL(SETA,SETB) = VALOF $(stql
   FOR I=0 TO NSETWDSM1 DO UNLESS SETA!I=SETB!I DO RESULTIS FALSE;
   RESULTIS TRUE
   $)stql;

  LET FLIPELEM(ELEM,SET) = VALOF $(flplm
   SET![ELEM>>P2WDSZ]NEQV:=1<<[ELEM NEQV [[ELEM>>P2WDSZ]<<P2WDSZ]];
   RESULTIS SET
   $)flplm;

  LET TESTELEM(ELEM,SET) =
   (0 NE [SET![ELEM>>P2WDSZ] BITAND
   [1<<[ELEM NEQV [[ELEM>>P2WDSZ]<<P2WDSZ]]]]);

  LET PUTELEM(ELEM,SET) =
   (TESTELEM(ELEM,SET) -> SET,FLIPELEM(ELEM,SET));

  LET REMELEM(ELEM,SET) =
   (TESTELEM(ELEM,SET) -> FLIPELEM(ELEM,SET),SET);

  LET DUNION(SETA,SETB) = VALOF $(dnn
   FOR I=0 TO NSETWDSM1 DO SETA!I BITOR:=SETB!I;
   RESULTIS SETA
   $)dnn;

  LET DUNDISJ(SETA,SETB) = VALOF $(dndsj
   FOR I=0 TO NSETWDSM1 DO SETA!I NEQV :=SETB!I;
   RESULTIS SETA
   $)dndsj;

  LET DINTERSECT(SETA,SETB) = VALOF $(dntrsct
   FOR I=0 TO NSETWDSM1 DO SETA!I BITAND :=SETB!I;
   RESULTIS SETA
   $)dntrsct;

  LET UNION(USET,SETA,SETB) = VALOF $(nn
   FOR I=0 TO NSETWDSM1 DO USET!I:=SETA!I BITOR SETB!I;
   RESULTIS USET
   $)nn;

  LET UNIONDISJ(USET,SETA,SETB) = VALOF $(ndsj
   FOR I=0 TO NSETWDSM1 DO USET!I:=SETA!I NEQV SETB!I;
   RESULTIS USET
   $)ndsj;

  LET INTERSECT(ISET,SETA,SETB) = VALOF $(ntrsct
   FOR I=0 TO NSETWDSM1 DO ISET!I:=SETA!I BITAND SETB!I;
   RESULTIS ISET
   $)ntrsct;

  LET COPYSET(CSET,SET) = VALOF $(cpyst
   FOR I=0 TO NSETWDSM1 DO CSET!I:=SET!I;
   RESULTIS CSET
   $)cpyst;

  LET ZEROSET(SET) =VALOF $(zrst
   FOR SETI=SET TO SET+NSETWDSM1 DO !SETI:=0;
   RESULTIS SET
   $)zrst;

$LIST

/* 
	CANONICALIZATION CODE.


	
*/

LET COMPAM(NNODES,NUM1,INV1,NUM2,INV2,AMROW) = VALOF $(cmpm
 /* COMPAM is function that "compares adjacency matrices" to
 determine which is "smallest". It is used both by GLIGPRCAN (via
 NUMFUN) and also directly by CANONCOMPS (from which GLIGPRCAN
 is called to give the indirect call on COMPAM).
 */
 STATIC $( ROW = NIL; ROWND = NIL; PTR = NIL; PTRTOP = NIL;
              AMRIX = NIL; UNEQFLAG = NIL; NBR = NIL $);
 ROW:=0;
 UNEQFLAG:=FALSE;

ROWLOOP:

 IF ROW=NNODES DO RESULTIS 0;
 ROW+:=1;
 ROWND:=INV1!ROW;
 PTR:=CTSTART!ROWND-1;
 PTRTOP:=CTSTOP!ROWND;

ROWEADD:

 IF PTR=PTRTOP DO GOTO ROWSUB;
 PTR+:=1;
 NBR:=CTABLE!PTR;
 TEST NBR>0 THEN AMROW![NUM1!NBR]+:=1
            OR IF NBR<0 DO AMROW![NUM1![-NBR]]+:=100;
 GOTO ROWEADD;

ROWSUB:

 ROWND:=INV2!ROW;
 PTR:=CTSTART!ROWND-1;
 PTRTOP:=CTSTOP!ROWND;

ROWESUB:

 IF PTR=PTRTOP DO 
               TEST UNEQFLAG THEN GOTO UNEQOUT 
                             OR GOTO ROWLOOP;
 PTR+:=1;
 NBR:=CTABLE!PTR;
 TEST NBR>0 THEN
  $(
  AMRIX:=NUM2!NBR;
  IF AMROW!AMRIX=0 DO UNEQFLAG:=TRUE;
  AMROW!AMRIX-:=1
  $)
 OR
  IF NBR<0 DO
   $(
   AMRIX:=NUM2![-NBR];
   IF AMROW!AMRIX<100 DO UNEQFLAG:=TRUE;
   AMROW!AMRIX-:=100
   $);
 GOTO ROWESUB;


UNEQOUT:

 UNEQFLAG:=0;
 FOR I=1 TO NNODES DO 
  IF AMROW!I NE 0 DO
   $(
   IF UNEQFLAG=0 DO TEST AMROW!I>0 THEN UNEQFLAG:=-1 OR UNEQFLAG:=1;
   AMROW!I:=0
   $);


 RESULTIS UNEQFLAG

 $)cmpm;



LET GLIGPRCAN(COMPVEC,COMPSZ,SCORVEC,GSCR,CANSCR) = VALOF $(GLGPRCN
 /* 

	Group-finder/Canonicalizer

	Composite function for finding symmetry group (represented as
 a set of permutations of node numbers) or for putting graph into
 a canonical form.


	This version of the Group-finder/Canonicalizer is "component
 oriented". Its first argument is the component vector, the first
 element of this vector defines the number of atoms considered to
 be in this component, the node numbers follow.

	(COMPSZ probably duplicates the data in COMPVEC!0)

	SCOREVEC is a vector of vectors, each subvector has an element
 for each atom in the component, these vectors define atom properties
 that may be used when partitioning atoms in the canonicalization
 procedure.

	CANSCR/GSCR these are vectors used to return the
 canonical numbering or the full permutation group.

	Normally,
	if given CANSCR but no GSCR then get back the canonical numbering
		in CANSCR (zeroth element is a hash key for the structure,
		rest is an inverse numbering giving nodes in their
		canonical order)

	if given GSCR but not CANSCR get full permutation group, first
		element is the canonical numbering rest is permutations

	if given vectors for both then identity element of group is
		put in CANSCR, rest of permutations defining group minus
		identity element go in GSCR.


 */

 STATIC $( NDARY1 = NIL; NDARY2 = NIL; NDARY3 = NIL; CL1 = NIL;
              CL2 = NIL; CLASSES1 = NIL; CLASSES2 = NIL; ND = NIL;
              NNODES = NIL; PTR = NIL; PTRTOP = NIL; DEG = NIL;
              DOTS = NIL; NBR = NIL; ONBR = NIL; CLPTR = NIL;
              NCLASS = NIL; CLNUM = NIL; MINPTR = NIL; MINNUM = NIL;
              REFNO = NIL; NCL = NIL; FIRSTGV = NIL; CLASSBROKEN = NIL;
              THISGV = NIL; HIGNODE = NIL; NODEMAX = NIL;
              NUMBERING = NIL; BESTNUMB = NIL; NUMBINV = NIL; BESTINV = NIL;
              GRPVEC = NIL; SZ0 = NIL; GRPTR = NIL; FIRSTNUMB = NIL;
              AMROW = NIL; REFINV = NIL; EXHAUSTED = NIL; INCLUDID = NIL;
              KEY = NIL; KEEPKEY = NIL; NSCORE = NIL; SCORIX = NIL;
              INODE = NIL; GROUP = NIL $);

 LET NUMFUN() BE $(NMFN
  STATIC $( NEWGP = NIL $);

  LET MAKEBEST() BE
   $(MKBST
   /* The current numbering found for the nodes is "best" on some
   scoring function. Copy this numbering from NUMBINV/NUMBERING into
   BESTINV/BESTNUM.
   */

   BLT(NUMBINV+1,BESTINV+1,BESTINV+NNODES);
   BLT(NUMBERING+HIGNODE+1,BESTNUMB+HIGNODE+1,BESTNUMB+NODEMAX);
   IF GRPVEC NE 0 DO
    TEST INCLUDID THEN
     $(
     GRPVEC!1:=0;
     GRPTR:=NNODES+1;
     BLT(BESTINV+1,GRPVEC+2,GRPVEC+GRPTR)
     $)
    OR GRPTR:=0
   $)MKBST


  IF FIRSTNUMB DO $(FRSTNMB
        /* First numbering obtained is always "best" so far! */
	FIRSTNUMB:=FALSE; 
	MAKEBEST(); 
	RETURN $)FRSTNMB

  /* Compare current numbering with that in BESTNUMB/BESTINV, etc. */
 
  SWITCHON COMPAM(NNODES,NUMBERING,NUMBINV,BESTNUMB,BESTINV,AMROW) INTO
   $(SW
   CASE -1: /* New numbering is "less", therefore replaces best so far. */
	    MAKEBEST(); 
            RETURN; 
            ENDCASE;
   CASE 0:  /* New numbering is equal, this means that it is an
            equivalent representation defining one of permutation forming
            symmetry group. If we are building the group we need to
            continue with it, otherwise just return.
            */
            IF GRPVEC=0 DO RETURN; 
            ENDCASE;
   CASE 1: /* New numbering is greater than best so far, ignore it. */
            RETURN
   $)SW

  /* Put another permutation into representation of group, unless
  have run out of room in which case do an error return.

	Each entry in the representation of the symmetry group consists
  of one tag word, then a set of words to hold the permutation. The tag
  word is the "disabled level" used when manipulating symmetry groups.

  */

  NEWGP:=GRPTR+NNODES+1;
  IF NEWGP>SZ0 DO $( EXHAUSTED:=TRUE; RETURN $);

  GRPTR+:=1;
  GRPVEC!GRPTR:=0;
  BLT(NUMBINV+1,GRPVEC+GRPTR+1,GRPVEC+NEWGP);
  GRPTR:=NEWGP
  $)NMFN

 LET RECLASSIFY(OLDCLASSES,NEWSCORES,NCLASS,NEWVECFLAG) = VALOF $(RCLSS
   STATIC $( NEWNCLASS = NIL; OPTR = NIL; OPTR0 = NIL; NPTR = NIL;
               CSCORE = NIL; NXSCORE = NIL; CLASSNODE = NIL;
               CNSCORE = NIL; NEWCLASSES = NIL; CLASSNO = NIL $);
//  OUTS("*C*LRECLASSIFY CALLED*C*L");
//  PTR:=0;
//  OUTS("OLDCLASSES:");
//  FOR I=1 TO NCLASS DO $( $( PTR+:=1; OUTNOS(OLDCLASSES!PTR) $)
//  REPEATUNTIL OLDCLASSES!PTR=0 $); NEWLINE(1);
//  PTR:=0;
//  OUTS("CORRESPONDING SCORES:");
//  FOR I=1 TO NCLASS DO $( $( PTR+:=1; TEST OLDCLASSES!PTR=0 DO OUTNOS(0) OR
//  OUTNOS(NEWSCORES![OLDCLASSES!PTR]) $) REPEATUNTIL OLDCLASSES!PTR=0 $);
//  NEWLINE(1);
  NEWNCLASS:=0;
  NPTR:=0;
  OPTR:=0;
  CLASSNO:=0;

CLASSESCAN:
  CLASSNO+:=1;
  IF CLASSNO>NCLASS DO
   $(DONE
   /*	All classes have been checked, return vector with result,
   either just the scrambled CLASSES2 vector, or a new vector 
   of appropriate size containing a copy of this data. */

   IF NEWVECFLAG=0 DO $( CLASSES2!0:=NEWNCLASS; RESULTIS CLASSES2 $);
   NEWCLASSES:=NEWVEC(NPTR);
   WHILE NPTR>0 DO $( NEWCLASSES!NPTR:=CLASSES2!NPTR; NPTR-:=1 $);
   NEWCLASSES!0:=NEWNCLASS;
   RESULTIS NEWCLASSES
   $)DONE

  IF OLDCLASSES![OPTR+2]=0 DO
   $(ENDCLASS
   CLASSES2![NPTR+1]:=OLDCLASSES![OPTR+1];
   NPTR+:=2;
   OPTR+:=2;
   CLASSES2!NPTR:=0;
   NEWNCLASS+:=1;
   GOTO CLASSESCAN
   $)ENDCLASS

  OPTR0:=OPTR;
  CSCORE:=MINUSINF;
  NXSCORE:=PLUSINF;
  NPTR-:=1;
  NEWNCLASS-:=1;


CLASSCAN:
  OPTR+:=1;
  CLASSNODE:=OLDCLASSES!OPTR;
  IF CLASSNODE=0 DO
   $(
   NPTR+:=1;
   CLASSES2!NPTR:=0;
   NEWNCLASS+:=1;
   TEST NXSCORE=PLUSINF THEN GOTO CLASSESCAN
   OR
     $(
     CSCORE:=NXSCORE;
     NXSCORE:=PLUSINF;
     OPTR:=OPTR0;
     GOTO CLASSCAN
     $);
   $);
  CNSCORE:=NEWSCORES!CLASSNODE;
  IF CNSCORE<CSCORE DO GOTO CLASSCAN;
  TEST CNSCORE=CSCORE THEN
   $( NPTR+:=1; CLASSES2!NPTR:=CLASSNODE; KEY:=[KEY ROTL KEYROT] NEQV CNSCORE $)
  OR IF CNSCORE<NXSCORE DO NXSCORE:=CNSCORE;
  GOTO CLASSCAN
  $)RCLSS

 LET CLASSBY(NDARY) = VALOF $(CLSSBY
  STATIC $( TEM = NIL $);
  TEM:=CLASSES1;
  CLASSES1:=RECLASSIFY(CLASSES1,NDARY,CLASSES1!0,0);
  CLASSES2:=TEM;
//OUTS("*C*LCLASSBY RETURNING ");OUTNOL(CLASSES1!0);
  RESULTIS CLASSES1!0
  $)CLSSBY


 LET GRAPHRECLASS() = VALOF $(GRPHRCL
  STATIC $( NCL = NIL; CLNO = NIL; CLPTR = NIL; ND = NIL; TEM = NIL;
               NDSCORE = NIL; PTR = NIL; PTRTOP = NIL; NBR = NIL $);
  /* This function provides a form of "Extended Connectivity" type
 partitioning of the atoms of a structure. The actual algorithm is
 fairly simple however the flow of control is a little obscure due
 to the intertwining of loops and "GOTO"s. The following steps
 are performed:
   i) fill NDARY1 with the current class numbers of all atoms.
  ii) fill NDARY2 with new scores to be used for partitioning the atoms,
	these new scores being derived from the class-numbers (in NDARY1)
	of each of the neighbours of a node.
 iii) try, via CLASSBY, to use these new scores to break up classes.

 If no further partitioning is achieved, then GRAPHRECLASS returns,
 otherwise the same procedures is applied another time around.

 */


GRCLOOP:


  NCL:=CLASSES1!0;
  CLNO:=0;
  CLPTR:=0;


CLASSLOOP:
  CLNO+:=1;
  IF CLNO>NCL DO GOTO MAKESCORES;


CLASSELOOP:

  /* Here fill in NDARY1 with current class-numbers for all nodes. */

  CLPTR+:=1;
  ND:=CLASSES1!CLPTR;
  IF ND=0 DO GOTO CLASSLOOP;

  NDARY1!ND:=CLNO;
  GOTO CLASSELOOP;


MAKESCORES:

  ND:=HIGNODE;

NDLOOP:
  ND+:=1;
  /* If all nodes have been assigned scores, then use CLASSBY to see
  if the scores improve the partitioning. */

  IF ND>NODEMAX DO
   TEST CLASSBY(NDARY2)>NCL THEN GOTO GRCLOOP OR RESULTIS NCL;


  /* Assign a score to an individual node by taking the sum of the
  square of the class numbers currently associated with its nearest
  neighbors.
  */
  NDSCORE:=0;
  PTR:=[CTSTART!ND]-1;
  PTRTOP:=CTSTOP!ND;


NBRLOOP:

  PTR+:=1;
  IF PTR>PTRTOP DO $( NDARY2!ND:=NDSCORE; GOTO NDLOOP $);
  NBR:=CTABLE!PTR;
  IF NBR<0 DO GOTO NBRLOOP;
  CLNO:=NDARY1!NBR;
  NDSCORE+:=CLNO*CLNO;
  GOTO NBRLOOP
  $)GRPHRCL



 LET GVIEW(NDVEC,NND) = VALOF $(GVW
  STATIC $( SCORE = NIL; PTR1 = NIL; PTR2 = NIL; PTR = NIL;
               PTRTOP = NIL; NXNODE = NIL; DIST = NIL; NBR = NIL;
               PTR2TOP = NIL $);
  /* Scores the atoms of a connected structure according to their
 distance from a set of atoms forming a zeroth level. Thus could,
 if appropriate, ask for the atoms of a structure to be scored 
 according to their minimum distances to the nearest methyl group;
 in which case NND would define the number of methyls and NDVEC
 would be a vector containing their index numbers.
 As well as providing these scores (which get put in NDARY2), the
 function generates a key or score that provides a kind of overall
 measure of how the structure looks from the designated atoms.

 This function is used in Ray's very elaborate atom partitioner.


 (Arrays like NDARY2 are addressed offset to a pointer, HIGHNODE, so
 element 0 of the vector actually referenced as NDARY2!HIGHNODE.)
 */

 
  SCORE:=0;
  PTR2:=NODEMAX;
  UNTIL PTR2=HIGNODE DO $( NDARY2!PTR2:=0; PTR2-:=1 $);
  PTR2TOP:=HIGNODE+NNODES;
  PTR1:=0;
  UNTIL PTR1=NND DO
   $(
   PTR1+:=1;
   NXNODE:=NDVEC!PTR1;
   NDARY2!NXNODE:=1;
   PTR2+:=1;
   NDARY1!PTR2:=NXNODE
   $);

  /* If, by some mischance, the entire structure was represented by
 the set of NND designated atoms, then we've finished since can't
 do anything!
 */

  IF PTR2=PTR2TOP DO $( NDARY2!HIGNODE:= [1 << 8]; RESULTIS NDARY2 $);
  PTR1:=HIGNODE;


NODELOOP:

  PTR1+:=1;
  NXNODE:=NDARY1!PTR1;
  DIST:=1+NDARY2!NXNODE;
  PTR:=CTSTART!NXNODE-1;
  PTRTOP:=CTSTOP!NXNODE;
  WHILE PTR<PTRTOP DO
   $(nbrs
   PTR:=PTR+1;
   NBR:=CTABLE!PTR;
   UNLESS NBR>0 DO TEST NBR=0 THEN LOOP OR NBR:=-NBR;
   IF NDARY2!NBR=0 DO
    $(unmapped
    NDARY2!NBR:=DIST;
    SCORE:=SCORE NEQV [1 << [DIST NEQV [[DIST >> 3] << 3]]];
    PTR2+:=1;
    IF PTR2=PTR2TOP DO
     $(alldone
     NDARY2!HIGNODE:=SCORE BITOR [[DIST NEQV [[DIST >> 7] << 7]] << 8];
     RESULTIS NDARY2
     $)alldone
    NDARY1!PTR2:=NBR
    $)unmapped
   $)nbrs
  GOTO NODELOOP
  $)GVW



LET CHOOSE(CLSLEFT,NCLS) BE $(chs
  /* Simple recursive function to assign next possible index number
 to next node, when several nodes may equally appropriately be
 assigned that index number then each choice is explored in turn.
 After a node has been assigned, then view the structure from
 that node to see if can further partition unassigned atoms
 (e.g. to partition them according to their distance from this
 newly numbered node so that lower index numbers cluster together).
 If no more nodes remain to be numbered then we've derived another
 candidate numbering for consideration as a canonical numbering
 or a symmetry permutation.
 */

  TEST CLSLEFT!2=0 THEN
   $(NoMoreThisType
   /* No other choices for current REFNO, continue with next deeper
   level of recursion for next choice, or if finished get the current
   numbering checked by NUMFUN().
   */
   REFNO+:=1;
   NUMBERING![CLSLEFT!1]:=REFNO;
   NUMBINV!REFNO:=CLSLEFT!1;
   TEST REFNO=NNODES THEN NUMFUN() OR CHOOSE(CLSLEFT+2, NCLS-1);
   REFNO-:=1
   $)NoMoreThisType 
  OR
   $(Equivatoms
   LET CHOICE,NEWCLASSES=1,NIL;
   /* Have a group of equivalent atoms, try each in turn for the next
   REFNO; pick one, do a GVIEW from it which automatically breaks it
   out as a unique member, then when recurse into CHOOSE again will
   find have no more choices and will assign it the next REFNO etc
   (indeed, it is a little indirect).
   */
   UNTIL CLSLEFT!CHOICE=0 DO
    $(thischoice
    NEWCLASSES:=RECLASSIFY(CLSLEFT,GVIEW(CLSLEFT+CHOICE-1,1),NCLS,1);
    CHOOSE(NEWCLASSES,NEWCLASSES!0);
    FREEVEC(NEWCLASSES);
    CHOICE+:=1
    $)thischoice
   $)Equivatoms 
$)chs



 /* Initialisation and allocation of work space for Group/Canonicalization
 functions.
 */

 NNODES:=COMPSZ;
 GRPVEC:=GSCR;
 EXHAUSTED:=FALSE;
 IF GRPVEC NE 0 DO SZ0:=GRPVEC!0;
 TEST CANSCR=0 THEN $( BESTINV:=NEWVEC(NNODES); INCLUDID:=TRUE $)
 OR $( BESTINV:=CANSCR; INCLUDID:=FALSE $);
 NUMBINV:=NEWVEC(NNODES);
 CL1:=NEWVEC(2*NNODES);
 CL2:=NEWVEC(2*NNODES);
 CLASSES1:=CL1;
 CLASSES2:=CL2;
 CLASSES1!0:=1;
 BLT(COMPVEC+1,CLASSES1+1,CLASSES1+NNODES);
 CLASSES1![NNODES+1):=0;
 HIGNODE:=PLUSINF;
 NODEMAX:=MINUSINF;
 INODE:=0;
 WHILE INODE<NNODES DO
  $(
  INODE+:=1;
  ND:=COMPVEC!INODE;
  IF ND<HIGNODE DO HIGNODE:=ND;
  IF ND>NODEMAX DO NODEMAX:=ND
  $);
 HIGNODE-:=1;
 BESTNUMB:=NEWVEC(NODEMAX-HIGNODE)-HIGNODE;
 NUMBERING:=NEWVEC(NODEMAX-HIGNODE)-HIGNODE;
 NDARY1:=NEWVEC(NODEMAX-HIGNODE)-HIGNODE;
 NDARY2:=NEWVEC(NODEMAX-HIGNODE)-HIGNODE;
 NDARY3:=NEWVEC(NODEMAX-HIGNODE)-HIGNODE;
 INODE:=0;

 /* Atoms will have to be partitioned in some logical way to reduce
 the variety of different numbering that will be considered. NDARY1,2 etc
 are here filled with some atom properties that can be used
 for such an initial partitioning.
 NDARY1 gets degree (number non-Hydrogen neighbors)
 NDARY2 gets pi-electrons (includes some code for aromatics with "0" neigbors,
				this of course currently incomplete).

 */

 WHILE INODE<NNODES DO
  $(AtomProps
  INODE+:=1;
  ND:=COMPVEC!INODE;
  NDARY3!ND:=0;
  PTR:=CTSTART!ND-1;
  PTRTOP:=CTSTOP!ND;
  DEG:=PTRTOP-PTR;
  NDARY1!ND:=DEG;
  DOTS:=0;
  NBR:=0;
  UNTIL PTR=PTRTOP DO
   $(piElectrons
   PTR+:=1;
   ONBR:=NBR;
   NBR:=CTABLE!PTR;
   TEST NBR=0 THEN DOTS:=DOTS+100 OR IF ONBR=NBR DO DOTS+:=1
   $)PiElectrons
  NDARY2!ND:=DOTS
  $)AtomProps
 KEY:=0;
 NSCORE:=SCORVEC!0;
 SCORIX:=0;

 /* Now PARTITION atoms by atom-properties, SCOREVEC is an array of
 appropriate atom properties computed earlier, use each of the
 properties that it describes (overall unusuallness score, atomset type,
 Hmin, Hmax and Artype) then the DEGREE and DOTS things just computed.
 */

 WHILE SCORIX<NSCORE DO $( SCORIX+:=1; NCLASS:=CLASSBY(SCORVEC!SCORIX) $);
 NCLASS:=CLASSBY(NDARY1);
 NCLASS:=CLASSBY(NDARY2);
 CLPTR:=0;
 MINNUM:=NNODES+1;
 NCL:=0;

 /* Now start on some more elaborate partitioning of the atoms,
 First, find how the atom-property partitioning helped and identify
 the partition class containing fewest examples. Then, can assign
 new scores to all the atoms of the molecule according to their
 distances from the relatively unique atoms in the smallest class.
 */
 UNTIL NCL=NCLASS DO
  $(CountSize
  NCL+:=1;
  CLPTR+:=1;
  CLNUM:=0;
  UNTIL CLASSES1!CLPTR=0 DO $( CLNUM+:=1; CLPTR+:=1 $);
  IF CLNUM<MINNUM DO $( MINNUM:=CLNUM; MINPTR:=CLPTR-CLNUM $)
  $)CountSize

 /* Possible that will get case where every atom completely equivalent
 at this stage (not likely in real structures but it would be true
 if we were at stage of "canonicalizing" molecular composition of
 a hydrocarbon before anything generated), anyway only try
 GVIEW partitioning if likely to be useful.
 */
 IF MINNUM<NNODES DO NCLASS:=CLASSBY(GVIEW(CLASSES1+MINPTR-1,MINNUM));



 /* Partitionings performed up to this point are primarily reflecting
 fairly local properties, mainly just node properties.
 GRAPHRECLASS() provides a fairly simple form of "Extended Connectivity"
 partitioning scheme.
 */
 NCLASS:=GRAPHRECLASS();


 /* Now start relatively elaborate PARTITION/EXAMINE/VIEW/REPARTITION loop. 


 Basically, the algorithm would appear to be
   for each current class 
       look at the molecule with GVIEW from each of the nodes in the class
	if, according to the GVIEW scores, the molecule looks different
	from different members of the class then this class can
	be further partitioned
		if can further partition this class, then do so using
		first the GVIEW scores just obtained then, via
		GRAPHRECLASS explore any further ramifications and
		implications of the new node classifications so
		obtained.

   if a class can be broken up, then after doing break up go back and
   restart then process of checking all classes.

  Terminate these iterative checks when find that completely unable
  to achieve further partitioning from scores returned by GVIEW.

  However, this process is felt to be relatively costly (primarily the
 GVIEW computations); so, the processing is abandoned if find a multi-element
 class that can not be split on basis of GVIEW scores (the "heuristic" is
 that if any multi-element class can be split then probably every multi-element
 class can be split)

 */

BREAKUPLOOP:

 /* Set up to check every current class. */
 NCL:=0;
 CLPTR:=1;


BCLASSLOOP:

 /* Proceed to next class, if all processed then no further partitioning
 can be obtained so go on to where start generating possible candidate
 canonical numberings.
 */
 NCL+:=1;
 IF NCL>NCLASS DO GOTO STARTNUMBERING;

 IF CLASSES1![CLPTR+1]=0 DO $(SINGLETON
        /* Skip if class only has one member. */
	CLPTR+:=2; 
	GOTO BCLASSLOOP $)SINGLETON

 FIRSTGV:=GVIEW(CLASSES1+CLPTR-1,1)!HIGNODE;
 NDARY3![CLASSES1!CLPTR]:=FIRSTGV;
 CLASSBROKEN:=FALSE;


BCLASSELOOP:

 CLPTR+:=1;
 ND:=CLASSES1!CLPTR;
 IF ND=0 DO
  TEST CLASSBROKEN THEN
   $(CanPartition
   NCLASS:=CLASSBY(NDARY3);
   NCLASS:=GRAPHRECLASS();
   GOTO BREAKUPLOOP
   $)CanPartition
  OR GOTO STARTNUMBERING;

 THISGV:=GVIEW(CLASSES1+CLPTR-1,1)!HIGNODE;
 IF THISGV NE FIRSTGV DO CLASSBROKEN:=TRUE;
 NDARY3!ND:=THISGV;
 GOTO BCLASSELOOP

STARTNUMBERING:

 /* All PARTITIONING based on atom properties/graph properties
 of structure has been done. Start assinging index numbers to
 the atoms, once index numbers assigned can accomplish some
 further partitioning as then working with canonical numbers.
 */

 KEEPKEY:=KEY;
 FIRSTNUMB:=TRUE;
 AMROW:=NEWVEC(NNODES);
 REFNO:=0;
 UNTIL REFNO=NNODES DO $( REFNO+:=1; AMROW!REFNO:=0 $);
 REFNO:=0;
//OUTS("ABOUT TO CALL CHOOSE; CLASSES1 = ");
//PTR:=0;
//FOR I=1 TO NCLASS DO $( $( PTR+:=1; OUTNOS(CLASSES1!PTR) $) REPEATUNTIL CLASSES1!PTR=0 $);
 CHOOSE(CLASSES1,NCLASS);
 BESTINV!0:=KEEPKEY;

 /* Numbering completed, Canonical numbering in BESTNUMB/BESTINV etc, symmetry
 group in GRPVEC if needed. */

 FREEVEC(AMROW);
 FREEVEC(NDARY3+HIGNODE);
 FREEVEC(NDARY2+HIGNODE);
 FREEVEC(NDARY1+HIGNODE);
 FREEVEC(NUMBERING+HIGNODE);
 FREEVEC(BESTNUMB+HIGNODE);
 FREEVEC(CL2);
 FREEVEC(CL1);
 FREEVEC(NUMBINV);

 /* Return results as appropriate to call sequence, may have to
 allocate a vector for the symmetry group and copy it out
 of GRPVEC
 */
 IF GRPVEC=0 DO RESULTIS BESTINV;
 IF CANSCR=0 DO $( GRPVEC!1:=KEEPKEY;  FREEVEC(BESTINV) $);
 IF EXHAUSTED DO $( 
	OUTS("SORRY SYMMETRY GROUP TOO LARGE, I'M LOST."); 
	RESULTIS 0
	$)
 GROUP:=NEWVEC(GRPTR);
 GROUP!0:=GRPTR/[NNODES+1];
 IF GRPTR>0 DO BLT(GRPVEC+1,GROUP+1,GROUP+GRPTR);
 RESULTIS GROUP
 $)GLGPRCN

LET COMPONENTS(GSTART,GSTOP) = VALOF $(cmpnnts
/* COMPONENTS
  used by CANONCOMPS and by PROCGLIMATCH

	This function builds and returns a data structure "COMPS" identifying
 the connected components amongst those atoms with indices from GSTART to
 GSTOP.

	The data structure is a vector of vectors:

     ----
    | #n |        number of components 
     ----
    | ---+-->component 1
     ----
    | ---+-->component 2
     ----
      etc


each component being a vector whose zeroth element is the number
of atoms in that component and whose other elements are the atom index
numbers.


	The algorithm is just a path-walking approach from each of the
nodes in the range GSTART-GSTOP. VISIT is called to find all atoms
attached to a selected node, these pushed onto stack; this repeated until
every node in range GSTART-GSTOP has been visited.
	The data on the number of components, size and membership is
then used to allocate vectors of appropriate size and the data
copied from the stack into these newly allocted vectors.

*/

 STATIC $( ND = NIL; NCOMP = NIL; VISITED = NIL; STACKPTR0 = NIL;
              COMPS = NIL; NCOMPI = NIL; COMPI = NIL $);

     LET VISIT(NODE) BE $(visitor
      STATIC $( NBR = NIL $);
      LET PTR,PTRTOP=CTSTART!NODE-1,CTSTOP!NODE;

      /* Recursive function for walking around a connected bit of a graph.
      Tags each node it visits and puts the node number on the stack,
      then calls itself for each of the neighbors of NODE that are not
      already tagged as having been visited.
      */

      VISITED!NODE:=TRUE;
      STACKPTR+:=1;
      STACK!STACKPTR:=NODE;
      WHILE PTR<PTRTOP DO
       $(nbrs
       PTR+:=1;
       NBR:=CTABLE!PTR;
       /* What next test says is 
          i) if the next neighbor is zero, then it indicates that
          we are at an aromatic atom, don't visit the 'zero' neighbor,
         ii) if the next neighbor is -ve, it means that the bond
          to that neighbor is of arbitrary order, actual NBR's index
          number requires changing sign.
        */
       UNLESS NBR>0 DO TEST NBR=0 THEN LOOP OR NBR:=-NBR;

       /* If that NBR hasn't been visited then do so. */
       UNLESS VISITED!NBR DO VISIT(NBR)
       $)nbrs
      $)visitor

 /* Allocate a vector to hold tags indicating if visited, note
 address manipulation etc to achieve somthing equivalent of
 an ALGOL declaration of VISITED :: integer array [GSTART:GSTOP]

 Complete initialization by clearing this vector, setting number of
 components found to zero etc.

 */

 VISITED:=NEWVEC(GSTOP-GSTART)-GSTART;
 ND:=GSTART-1;
 WHILE ND<GSTOP DO $( ND+:=1; VISITED!ND:=FALSE $);
 NCOMP:=0;
 ND:=GSTART-1;

 /* Try each Node in range to GSTART to GSTOP, if the node
 has not already been reached as part of a previous component (VISITED!ND = FALSE)
 then its the first node of a new component so start graph exploration from it.
 */

 WHILE ND<GSTOP DO
  $(NDSinPart
  ND+:=1;
  IF VISITED!ND DO LOOP;
  STACKPTR0:=STACKPTR;			/* Used when deciding size of this component. */

  VISIT(ND);

  /* Increment number of components found, find size of this one by
  change in STACKPTR across call to VISIT, and push this size value onto
  the stack.
  */

  NCOMP+:=1;
  NCOMPI:=STACKPTR-STACKPTR0;
  STACKPTR+:=1;
  STACK!STACKPTR:=NCOMPI
  $)NDSinPART
 FREEVEC(VISITED+GSTART);


 /* Now know the number of seperate components, each of these represented
 by a little block of data on the stack, this data being the node numbers
 + component size. Unwind down stack using this data to allocate
 and fill vectors for each component.
 */

 COMPS:=NEWVEC(NCOMP);
 COMPS!0:=NCOMP;
 WHILE NCOMP>0 DO
  $(nextcomponent
  NCOMPI:=STACK!STACKPTR;
/* Adjust Stackptr to reflect size of component about to be transferred off. */
  STACKPTR0:=STACKPTR-NCOMPI;			
  COMPI:=NEWVEC(NCOMPI);		
  COMPI!0:=NCOMPI;
/* Use block transfer to get all data from appropriate address in stack to 
appropriate address in new component vector. */
  BLT(STACK+STACKPTR0,COMPI+1,COMPI+NCOMPI);    
  COMPS!NCOMP:=COMPI;
  STACKPTR:=STACKPTR0-1;			/* Move stackptr off bottom of this component. */
  NCOMP-:=1
  $)nextcomponent
 RESULTIS COMPS
 $)cmpnnts



LET FREECOMPS(COMPS) BE $(frc
 STATIC $( NCOMPS = NIL $);
 /* Just frees each of the vectors defining nodes in each component, then
 frees overall vector that used to describe the number of components and
 hold pointers to their individual vectors.
 */

 NCOMPS:=COMPS!0;
 WHILE NCOMPS>0 DO $( FREEVEC(COMPS!NCOMPS); NCOMPS-:=1 $);
 FREEVEC(COMPS)
 $)frc

LET FREECOMPREC(COMPREC,GROUPTOO) = VALOF
 $( STATIC $( COMP = NIL; CANVAL = NIL $);
 /* Give back most of a complete COMPREC data structure just returning
 the simpler bit that defines the number of and identity of the atoms in the
 component. GROUPTOO flags whether this instance of a COMPREC
 data structure had a copy of a symmetry group, if so this has 
 also to be released.
  */
 COMP:=COMPREC!0;
 IF GROUPTOO DO CANVAL:=COMPREC!4;
 FREEVEC(COMPREC);
 IF GROUPTOO DO FREEVEC(CANVAL);
 RESULTIS COMP
 $);




LET CANONCOMPS(GSTART,GSTOP,SCORVEC,GSCRATCH) = VALOF $(CanonicalComps

 /* CANONCOMPS creates a record structure with a canonical representation of
 the (possibly multicomponent) bit of structure with nodes in the
 range GSTART to GSTOP. CANONCOMPS is used by MAKEGLITAB, INTERP and
 UNIQUECGP.

	CANONCOMPS  
            COMPONENTS
            GLIGPRCAN
            FREECOMPREC/FREECOMPS
            COMPAM

 Use of GLIGPRCAN by CANONCOMPS:

a)  For calls from MAKEGLITAB and INTERP, the GSCRATCH argument is 
 provided and the Group is computed as well as the canonical numbering.

b)  When called from UNIQUECGP, GSCRATCH is 0 and only the canonical
 numbering is obtained from GLIGPRCAN.


	CANONCOMPS builds a data structure "COMPS" which is a vector each
 element of which is a "COMPREC". There is one COMPREC for each connected
 component of atoms with index numbers in range GSTART to GSTOP.

	A COMPREC has 4 or 5 elements depending on whether or not it
 needs a copy of the group. The first element, COMPREC!0, is
 the vector defining the number of and identity of the atoms in this
 component. The atom index numbers in this vector are in fact rearranged
 to be in their canonical order. 
        COMPEC!1 is used to tag whether or not a particular instance
 of a component is the "representative" instance. Suppose one had a
 contraint defining a substructure that consisted of one hydroxy group
 and two identical carbonyl groups; then there would be three components
 the one atom hydroxy and the two, two-atom carbonyls. One of these
 carbonyls would be designated as the "representative" instance.

	COMPREC!2 is used to link together different instances of 
 identical components, so in the case with two carbonyls, 
 [COMPS!3]!2 would contain the link back from the second to the
 first carbonyl group.

	COMPREC!1/COMPREC!2 provide the data used when identifying
 which atoms to use for bonding and so avoid simply creating duplicates
 by interchanging identical pieces.

	COMPREC!3, this holds the "disabled level" flag used to
 select relevant permutations in a group when processing groups to
 find orbit representative atoms.

	COMPREC!4 points to a vector containing the symmetry group
 if this is required.


	
 ----

	CANONCOMPS must get COMPONENTS() to find the components, determine
 if there are any equivalent ones if so designate one as the representative
etc.




 */
  STATIC $( COMPS = NIL; NCOMPS = NIL; COMPIX = NIL; COMP = NIL;
              COMPSZ = NIL; CANVAL = NIL; COMPREC = NIL; NUMBERING = NIL;
              NDIX = NIL; COMPIX2 = NIL; COMPREC2 = NIL; COMP2 = NIL;
              COMPARISON = NIL; TEM = NIL; NSCORE = NIL; SCORIX = NIL;
              SCORES = NIL; FIRSTND = NIL; FIRSTND2 = NIL; MAXCSZ = NIL;
	      NABGSCR = NIL; NSCR = NIL;
              AMROW = NIL $);


 LET XTIME = 0;

  /* First by a call to COMPONENTS, find the number of seperate bits of
 structure represented by nodes with this range of index numbers and
 get a data structure representing each such group of connected nodes.
 */

//   XTIME:=MSRUNTIME()


 COMPS:=COMPONENTS(GSTART,GSTOP);
 NCOMPS:=COMPS!0;
 NABGSCR:=NEWVEC(NCOMPS)
 COMPIX:=0;
 MAXCSZ:=0;

 WHILE COMPIX<NCOMPS DO
  $(eachcomponent
  COMPIX+:=1;
  COMP:=COMPS!COMPIX;
  COMPSZ:=COMP!0;
  IF COMPSZ>MAXCSZ DO MAXCSZ:=COMPSZ;

 /* Call GLIPRCAN, by passing it COMP as the fifth argument we
 actually get the atoms of the current component put into their
 canonical order. Note that element zero of COMP, which is normally used
 to contain number of atoms in the component, gets overwritten by
 a "canonical key" (thats why size of component is kept in COMPSZ).
    (we also get back group (minus identity element) if GSCRTATCH non-zero as
 in calls from INTERP/MAKEGLITAB).
 */
  
  CANVAL:=GLIGPRCAN(COMP,COMPSZ,SCORVEC,GSCRATCH,COMP);

  /* Allocate space for the COMPREC,  this will be four or five 
 elements long (NEWVEC(3)/(4)!) depending on whether or not the COMPREC is to include
 a copy of the symmetry group.
  */
  TEST GSCRATCH=0 THEN COMPREC:=NEWVEC(3)
  OR $(needgroup
   /* CANVAL is a vector containing a representation of the symmetry
  group, (element zero is number of different permutations).
  If the group was too large, then GLIGPRCAN will have given up
  and just returned zero, that forces a kind of error exit; have
  to clear up freeing any space used so far and return.
  */

   IF CANVAL=0 DO
    $(grptoolrg
    WHILE COMPIX>1 DO
     $(
     COMPIX-:=1;
     COMPS!COMPIX:=FREECOMPREC(COMPS!COMPIX,TRUE)
     $);
    FREECOMPS(COMPS);
    RESULTIS 0
    $)grptoolrg
   COMPREC:=NEWVEC(4);
   COMPREC!4:=CANVAL
   $)needgroup

  /* Fill in COMPREC, initially each such record is marked as a 
  representative for we haven't yet compared them. The "canonical
  key" for this bit is copied out of COMP!0 where it was put
  by GLIGPRCAN and the number of atoms in the component put back
  into COMP!0 for future use.
  */

  COMPREC!0:=COMP;
  COMPREC!1:=TRUE;
  COMPREC!2:=0;
  COMPREC!3:=COMP!0;
  COMP!0:=COMPSZ;
  COMPS!COMPIX:=COMPREC

  /* MOD BY NABG. GET AN ADDITIONAL SCORE FOR USE IN ORDERING COMPONENTS.
  IT MAKES THAT COMPONENT THAT IS MOST UNUSUAL COME FIRST.
  SCORES IN SCORVEC!1 WILL NORMALLY BE -ve
  */
  NABGSCR!COMPIX:=0
  for ND=1 to COMPSZ do NABGSCR!COMPIX+:=[(SCORVEC!1)!(COMP!ND)]
  $)eachcomponent


 NUMBERING:=NEWVEC(GSTOP-GSTART)-GSTART;
 AMROW:=NEWVEC(MAXCSZ);
 WHILE MAXCSZ>0 DO $( AMROW!MAXCSZ:=0; MAXCSZ-:=1 $);
 COMPIX:=0;

 
 WHILE COMPIX<NCOMPS DO
  $(eachComponent
  COMPIX+:=1;
  COMPREC:=COMPS!COMPIX;
  COMP:=COMPREC!0;
  COMPSZ:=COMP!0;
  NDIX:=0;
  WHILE NDIX<COMPSZ DO $( NDIX+:=1; NUMBERING![COMP!NDIX]:=NDIX $);
  COMPIX2:=1;

  /* Now compare the component COMPIX with all which have smaller
  index numbers.
  */
  WHILE COMPIX2<COMPIX DO
   $(eachlesserComponent
   COMPREC2:=COMPS!COMPIX2;
   /* Skip over a component if know that it is not the representative
   instance (because its already been found to be equivalent to something
   with a lower index number).
   */
   UNLESS COMPREC2!1 DO $( COMPIX2+:=1; LOOP $);

   COMP2:=COMPREC2!0;
   FIRSTND2:=COMP2!1;
   COMPARISON:=0;
   NSCORE:=SCORVEC!0;
   SCORIX:=0;

   /* EXPERIMENTAL MOD BY NABG. USE OVERALL SCORES AS FIRST CRITERION
  FOR SORTING COMPONENTS, TRYING TO GET THAT WHICH IS MOST UNUSUAL OVERALL
  TO COME FIRST. 
  */
   COMPARISON:=(NABGSCR!COMPIX-NABGSCR!COMPIX2)
  
   /* First try ordering the two components according to "SCORE" values
   associated with just their first nodes. There are a variety of
   atom scores including an overall estimate of uniqueness, h-mins etc.
   Try all of them.
   */

   FIRSTND:=COMP!1;
   if COMPARISON= 0 then 
     WHILE SCORIX<NSCORE DO
	    $(FirstAtomScores
	    SCORIX+:=1;
	    SCORES:=SCORVEC!SCORIX;
	    COMPARISON:=SCORES!FIRSTND-SCORES!FIRSTND2;
	    IF COMPARISON NE 0 DO BREAK
	    $)FirstAtomScores


   /* If that didn't provide a basis for ordering them, then try
   arranging it so that smaller  one comes first. */

   IF COMPARISON=0 DO COMPARISON:=COMPSZ-COMP2!0;

   /* If they are the same size, then compare their "canonical keys". */

   IF COMPARISON=0 DO COMPARISON:=COMPREC!3-COMPREC2!3;

  /* Mod by NABG, the canonical key may not adequately define atom
  properties, so must check through all atoms of the substructures to
  determine whether there are any differences that can serve to define
  a relative ordering of substructures.
  */
  if (COMPARISON=0) & (COMPSZ GR 1) then $(atprop
    for NXND=2 to COMPSZ do $(NDcmp
	FIRSTND:=COMP!NXND
	FIRSTND2:=COMP2!NXND
	SCORIX:=0;
	WHILE SCORIX<NSCORE DO
	    $(OtherAtomScores
	    SCORIX+:=1;
	    SCORES:=SCORVEC!SCORIX;
	    COMPARISON:=SCORES!FIRSTND-SCORES!FIRSTND2;
	    IF COMPARISON NE 0 DO BREAK
	    $)OtherAtomScores
	if COMPARISON NE 0 do BREAK
	$)NDcmp
   $)atprop
   /* If they have the same canonical keys then have to compare their
   ajacency matrices. 
   */
   IF COMPARISON=0 DO
    COMPARISON:=COMPAM(COMPSZ,NUMBERING,COMP,NUMBERING,COMP2,AMROW);
   IF COMPARISON>0 DO $( COMPIX2+:=1; LOOP $);
   IF COMPARISON=0 DO $( COMPREC2!1:=FALSE; COMPREC!2:=COMPREC2 $);
   COMPIX2-:=1;
   NSCR:=NABGSCR!COMPIX
   WHILE COMPIX2<COMPIX DO
    $( COMPIX2+:=1; 
	TEM:=COMPS!COMPIX2; COMPS!COMPIX2:=COMPREC; COMPREC:=TEM 
	TEM:=NABGSCR!COMPIX2; NABGSCR!COMPIX2:=NSCR; NSCR:=TEM
	$);
   BREAK
   $)eachlesserComponent
  $)eachComponent

 FREEVEC(NABGSCR)
 FREEVEC(AMROW);
 FREEVEC(NUMBERING+GSTART);
 COMPIX:=0;

 /* Finally, clear out the "DISL" scratch fields of the COMPRECs
 as have finished with the canonical numbers associated with cases
 and will need zeros for initial DISL values.
 */
 WHILE COMPIX<NCOMPS DO $( COMPIX+:=1; [COMPS!COMPIX]!3:=0 $);

//   TIMINGS!TIMECANONCOMPS+:=MSRUNTIME()-XTIME

 RESULTIS COMPS
 $)CanonicalComps



LET FREECC(COMPS,GROUPTOO) BE
 $( STATIC $( NCOMPS = NIL $);
 NCOMPS:=COMPS!0;
 WHILE NCOMPS>0 DO
  $( COMPS!NCOMPS:=FREECOMPREC(COMPS!NCOMPS,GROUPTOO); NCOMPS-:=1 $);
 FREECOMPS(COMPS)
 $);


LET PNODESCORE(P,NTYPES,TYPENUMS) = VALOF $(NdScr
 STATIC $( NNONMATCH = NIL; ITYPE = NIL; NDOT = NIL; NNBRS = NIL;
               CTPTR = NIL; PTRTOP = NIL; NBR = NIL; ONBR = NIL $);
  /* This function computes a score for an atom in a pattern. The score
  is supposed to give some indication of how unusual that node is;
  later this will allow one to graph match starting with the unusual
  nodes (this tends to be more efficient as if graph match going
  to fail more likely to find this out early on).

  The two score tables, ARSCR and HYBSCR, are an addition by NABG,
 they are intended to give relative uniqueness scores to different bit
 combinations for the set variables ARTYPE and HYBRIDTYPE.
 Thus on aromatics "must be arom" scores 2, "must be non-arom" scores 1
 and "either" scores 0;
 similarly for HYBRIDS, type 15 (any) scores 0, type 8 =X= scores best
 with 7.
  */
  STATIC $( ARSCR = [TABLE 0,1,2,0];
	    HYBSCR = [TABLE 0,4,5,2,6,3,4,2,7,3,5,6,4,4,0]
         $)
  NNONMATCH:=0;
  ITYPE:=0;

  WHILE ITYPE<NTYPES DO
   $(chktypItyp
   /* NNONMATCH score is total number of atoms of composition that
   cannot possibly match this pattern node, (pattern node could
   of course be a "POLYATOM" capable of being matched to severl
   different atoms).
   */
   ITYPE+:=1;
   UNLESS TESTELEM(ITYPE,ATTYPE!P) DO NNONMATCH+:=TYPENUMS!ITYPE
   $)chktypItyp

  NDOT:=0;
  NNBRS:=0;
  ONBR:=0;
  CTPTR:=CTSTART!P-1;
  PTRTOP:=CTSTOP!P;
  WHILE CTPTR<PTRTOP DO
   $(PsNbrs
   CTPTR+:=1;
   NBR:=CTABLE!CTPTR;
   TEST ONBR=NBR THEN NDOT+:=1 OR NNBRS+:=1;
   ONBR:=NBR
   $)PsNbrs

/* Mod by NABG, inclusion of HYBRIDTYPE as part of score */

  RESULTIS [NNONMATCH<<17]+ [NDOT<<14] + [ARSCR!(ARTYPE!P)<<12]+
	[HYBSCR!(HYBRIDTYPE!P)<<8]+[NNBRS<<5]+(HMIN!P<<3)-HMAX!P+HMIN!P

  $)NdScr

let FINDCOUNTNODESANDEDGES(GSTART,GSTOP) be $(FndCountNDsEDGs

 static $( NBR = NIL; ND = NIL; ONBR = NIL; PTR = NIL; PTRTOP = NIL $);

 /* Now it's necessary to identify COUNT-EDGES and/or COUNT-NODES,
 these determine the real meaning of the min and max counts associated
 with the current substructure.
 */

 STACKPTR:=STACKBOTTOM;
 NCE:=0;
 NCN:=0;
 ND:=GSTART-1;
 WHILE ND<GSTOP DO
  $(PatND
  /* Look at next node in pattern. */

  ND+:=1;

  /* If Count-Nodes being used, one can restrict consideration
  to the nodes bearing tags (element 0 of atom-type).
  */

  IF ANYCN DO UNLESS TESTELEM(0,ATTYPE!ND) DO LOOP;


  ISOLATD:=TRUE;
  ONBR:=0;
  PTR:=CTSTART!ND-1;
  PTRTOP:=CTSTOP!ND;

  WHILE PTR<PTRTOP DO
   $(NdNbrs
   PTR+:=1;
   NBR:=ABS[CTABLE!PTR];
   IF ONBR=NBR DO LOOP;
   ONBR:=NBR;
   IF ANYCN DO UNLESS TESTELEM(0,ATTYPE!NBR) DO LOOP;
   ISOLATD:=FALSE;
   IF NBR>ND DO LOOP;
   /* Have a Count-Edge, i.e. any ordinary edge in standard untagged
   structure or and edge between two tagged atoms in a tagged structure.
   */

   NCE+:=1;
   STACKPTR+:=2;
   STACK![STACKPTR-1]:=ND;
   STACK!STACKPTR:=NBR
   $)NdNbrs
  UNLESS ISOLATD DO LOOP;

  
  /* Any isolated node is a count node. */
  NCN+:=1;
  STACKPTR+:=2;
  STACK![STACKPTR-1]:=ND;
  STACK!STACKPTR:=0
  $)PatND

 /* Allocate space for special vectors identifying count-edges and
 count-nodes, then fill in these with appropriate data.
 */

 CEN1:=(NCE>0 ->NEWVEC(NCE),0);
 CEN2:=(NCE>0 -> NEWVEC(NCE),0);
 CN:=(NCN>0 -> NEWVEC(NCN),0);
 NCE:=0;
 NCN:=0;
 WHILE STACKPTR>STACKBOTTOM DO
  $(stackitem
  NBR:=STACK!STACKPTR;
  TEST NBR=0 THEN
   $(nd
   NCN+:=1;
   CN!NCN:=STACK![STACKPTR-1]
   $)nd	     
  OR
   $(bnd
   NCE+:=1;
   CEN1!NCE:=STACK![STACKPTR-1];
   CEN2!NCE:=NBR
   $)bnd
  STACKPTR-:=2
  $)stackitem

$)FndCountNDsEDGs


let SCOREANDCANONICALIZE(GSTART,GSTOP,GSCRATCH,NTYPES,TYPENUMS,SIGN) = valof $(SCCNLZ
 /*    SCOREANCANONICALIZE has to create, and return as its value, a
 data structure defining a "canonical representation" of the current Good List
 Item comprising nodes GSTART to GSTOP. In addition, while making its
 pass through the nodes in the GLI-item to assign them scores, SCOREANDCANONICALIZE
 detects whether "COUNT NODES" are being used (these are nodes bearing "TAG"
 markers).
	SCOREANDCANONICALIZE is limited to setting up work space, and
 deriving a set of scores that can be used to partition atoms during
 the canonicalization process. The real work of finding the canonical
 form is actually done in routine CANONCOMPS.
 */
 static $(
 ATSET = NIL;
 COMPS1 = NIL;
 ND = NIL;
 NEWTYPE = NIL; 
 ONSW = NIL;
 OSPTR = NIL;
 PNSCORE = NIL; 
 RELATTYPE = NIL;
 SCORVEC = VEC 7;
 SETIX = NIL
 $)
 STACKBOTTOM:=STACKPTR;
 /* PNSCORE will hold a relative unusuallness score for each node in
 the GLI-item. RELATTYPE carries info on atom types, it allows conversion
 away from Atom-sets (which is what atom-types actually are) into a
 simple integer score by identifying each different atom-set used
 and arbitrarily indexing them.
 */

 PNSCORE:=NEWVEC(GSTOP-GSTART)-GSTART;
 RELATTYPE:=NEWVEC(GSTOP-GSTART)-GSTART;
 OSPTR:=STACKPTR;
 ANYCN:=FALSE;
 ONSW:=NSETWDSM1;
 NSETWDSM1:=NTYPES>>P2WDSZ;
 ND:=GSTART-1;

 WHILE ND<GSTOP DO
  $(PatNd
  /* Look at each node of GLI-item (nodes in range GSTART to GSTOP) 
  */
  ND+:=1;
  MAPPEDTO!ND:=0;
  SYMLIM!ND:=0;
  /* Score it, also while we are working through them note
    if have any nodes which have tags on as this is going to modify
    the way matchings get counted later on.
  */
  PNSCORE!ND:=SIGN*PNODESCORE(ND,NTYPES,TYPENUMS);
  ATSET:=ATTYPE!ND;
  IF TESTELEM(0,ATSET) DO ANYCN:=TRUE;

  NEWTYPE:=TRUE;
  SETIX:=OSPTR;

  WHILE SETIX<STACKPTR DO
   $(checkset
   /* Look to see if another node in pattern has identical set of
   possible matching atoms.
   */

   SETIX+:=1;
   UNLESS SETEQUAL(ATSET,STACK!SETIX) DO LOOP;
   RELATTYPE!ND:=SETIX-OSPTR;
   NEWTYPE:=FALSE;
   BREAK
   $)checkset

  UNLESS NEWTYPE DO LOOP;
  STACKPTR+:=1;
  STACK!STACKPTR:=ATSET;
  RELATTYPE!ND:=STACKPTR-OSPTR
  $)PatNd

 STACKPTR:=OSPTR;
 NSETWDSM1:=ONSW;

 /* Now have a set of properties which can be used for scoring atoms
 in canonicalizer and thus determine the canonical form for substructure.
 */

 SCORVEC!0:=7;
 SCORVEC!1:=PNSCORE; // Thats the overall node scores
 SCORVEC!2:=RELATTYPE; // this identifies the atom types (sets converted to index numbers)
 SCORVEC!3:=HMIN; // Hmin, Hmax and Artype
 SCORVEC!4:=HMAX;
 SCORVEC!5:=ARTYPE;
/* Mods by NABG. */
 SCORVEC!6:=HYBRIDTYPE
 SCORVEC!7:=UMARKS

 
 /* Find all seperate components in this GLI item. 
  Build COMPS type data-structure, each entry being a COMPREC containing
  not just a canonicalized version of each seperate component in this
  GLI item but also a copy of the appropriate symmetry group etc.

 */

 COMPS1:=CANONCOMPS(GSTART,GSTOP,SCORVEC,GSCRATCH);
 FREEVEC(RELATTYPE+GSTART);
 FREEVEC(PNSCORE+GSTART);

 resultis COMPS1
 $)SCCNLZ



 
 let CREATEMATCHTABLEANDSYMMETRY(GSTART,GSTOP,COMPS) = valof $(csym
/*


Approximate form for a MATCH-TABLE entry:

 P	 atom to be matched
 PDEG    degree
 PUM     (number of neighbours of P not yet located/assigned
 PUMBO   (total bond order to such neighbors

  P, PDEG, PUM, PUMBO, <known bnd entry>, <known bnd entry> etc

 <known bnd entry> has one of two forms
      <mapped nbr #>    (if bond order is 1)
     -<mapped nbr #>, bond order  (others)



Example:

    Assume substructure gets nodes scored and assigned matching order
as shown here:


     6   5
      \ /
       1
      / \
     4   2
      \ =
       3


 GLITABLEs relevant at different stages of matching
		(this data not complete needs checking!)

    1  4  4  0		for node 1, degree is 4 none yet matched
				    bond order to be filled is 4, no other data.    


    1  4  4  0  2  3  1  2  1 0
			for node 2, data same on node 1, node 2 has degree
				3, one unmatched nbr, bnd order left is 2,
				mapped nbr is 1 to which have single bond

    1  4  4  0  2  3  1  2  1  0  3  3  1  1 -2  2 0
			for node 3, degree is 3, 1 nbr left, 1 bond left,
				mapped nbr is 2 (-2) to which have a
				double bond.




*/

 static $(
BESTCOL = NIL;
BESTTOTBORD = NIL; 
BORD = NIL;
COL = NIL; 
COMP = NIL; 
COMPIX = NIL; 
COMPREC = NIL;
COMPSZ = NIL; 
GPTR = NIL; 
GROUP = NIL; 
GSIZE = NIL; 
IMGND = NIL; 
NBR = NIL; 
NCHOSEN = NIL; 
NCOMP = NIL; 
ND = NIL; 
P = NIL; 
PDEG = NIL;
PERMIX = NIL;
PREVLIM = NIL; 
PTR = NIL;
PTRTOP = NIL; 
PUM = NIL; 
PUMLOC = NIL; 
OCOMP1 = NIL;
ONBR = NIL; 
OP = NIL; 
OSPTR = NIL;
SEQIX = NIL; 
SEQNO = NIL; 
TABL1 = NIL;
TABSZM1 = NIL; 
TOTBORD = NIL; 
WHICHCOL = NIL 
$)

 LET COMPINC(ND) = (ND=0 -> 0,COMP![WHICHCOL![SEQNO!ND]]);

 LET PUTTABE() BE $(PutTableEntry
  /* "ONBR" is a neighbor of some current node ("P")
	Uncertain about ONBR=0 (may already have got aromatics tagged
	in, these could correspond to zero NBRs or it may just be
	that end-of-loop tests appropriate to calling functions are
	incomplete.

      If ONBR has been mapped, then it represents a node in the GLI-item
	that should be matched before current node and should make an
	entry defining the bond back from current atom to that neighbor
        by giving neighbor number and bond-order back (if bond-order
	is 1 then it doesn't have to be entered, if bond-order greater
	than 1 then its the negative value of the atom index number
        followed by the bond-order). "ANY" bonds have order -1.

      If ONBR hasn't been mapped, then just increase "unmatched bonds of P".
  */
  UNLESS ONBR=0 DO
   TEST MAPPEDTO!ONBR=0 THEN PUM+:=1
   OR
    TEST BORD=1 THEN $( STACKPTR+:=1; STACK!STACKPTR:=ONBR $)
    OR $( STACKPTR+:=2; STACK![STACKPTR-1]:=-ONBR; STACK!STACKPTR:=BORD $);
  $)PutTableEntry 

 let REPCOMPON() be
   $(repcompon
   /* When the GLI item contains several identical components, one
   is designated as the representative example. This code is
   for processing that representative component.
   */
   COMP:=COMPREC!0;	/* This is vector giving index numbers of atoms in this component. */
   COMPSZ:=COMP!0;	/* COMPSZ is number in the component. */
   GROUP:=COMPREC!4;
   UNLESS WHICHCOL=0 DO FREEVEC(WHICHCOL);
   WHICHCOL:=NEWVEC(COMPSZ);
   P:=COMP!1;
   OSPTR:=STACKPTR;
   STACKPTR+:=5;
   PTR:=CTSTART!P-1;
   PTRTOP:=CTSTOP!P;
   PDEG:=PTRTOP-PTR;
   ONBR:=0;
   PUM:=0;
   WHILE PTR<PTRTOP DO
    $(nbrs
    PTR+:=1;
    NBR:=CTABLE!PTR;
    UNLESS ONBR=NBR DO PUM+:=1;
    ONBR:=NBR
    $)nbrs

   /* Here building up part of the GLITABLE on the STACK. */
   STACK![STACKPTR-4]:=P;	// Node number
   STACK![STACKPTR-3]:=PDEG;    // degree
   STACK![STACKPTR-2]:=PUM;     // unmatched nbrs
   STACK![STACKPTR-1]:=PDEG;    // degree (gets modified to be count of residual bonds)
   STACK!STACKPTR:=0;
   NCHOSEN:=1;
   MAPPEDTO!P:=1;
   WHICHCOL!1:=1;
   SEQNO!P:=1;
    $(rpt
    BESTTOTBORD:=-1;
    COL:=1;
    WHILE COL<COMPSZ DO
     $(whCOL
     COL+:=1;
     P:=COMP!COL;
     UNLESS MAPPEDTO!P=0 DO LOOP;
     PTR:=CTSTART!P-1;
     PTRTOP:=CTSTOP!P;
     TOTBORD:=0;
     WHILE PTR<PTRTOP DO
      $(whNbr
      PTR+:=1;
      NBR:=ABS[CTABLE!PTR];
      UNLESS MAPPEDTO!NBR=0 DO TOTBORD+:=1
      $)whNbr

     IF TOTBORD>BESTTOTBORD DO $( BESTTOTBORD:=TOTBORD; BESTCOL:=COL $)
     $)whCOL
    IF BESTTOTBORD=-1 DO BREAK;
    NCHOSEN+:=1;
    WHICHCOL!NCHOSEN:=BESTCOL;
    P:=COMP!BESTCOL;
    MAPPEDTO!P:=1;
    SEQNO!P:=NCHOSEN;
    STACKPTR+:=1;
    STACK!STACKPTR:=P;
    PTR:=CTSTART!P-1;
    PTRTOP:=CTSTOP!P;
    PDEG:=PTRTOP-PTR;
    STACKPTR+:=1;
    STACK!STACKPTR:=PDEG;
    PUMLOC:=STACKPTR+1;
    STACKPTR+:=2;
    STACK!STACKPTR:=PDEG-BESTTOTBORD;
    ONBR:=0;
    PUM:=0;
    WHILE PTR<PTRTOP DO
     $(NBRS
     PTR+:=1;
     NBR:=CTABLE!PTR;
     TEST NBR=ONBR THEN $( BORD+:=1; LOOP $)
     OR PUTTABE();
     TEST NBR>0 THEN $( BORD:=1; ONBR:=NBR $)
     OR $( BORD:=-1; ONBR:=-NBR $)
     $)NBRS
    PUTTABE();
    STACKPTR+:=1;
    STACK!STACKPTR:=0;
    STACK!PUMLOC:=PUM
    $)rpt REPEAT;
   GSIZE:=GROUP!0;
   GPTR:=-COMPSZ;
   PERMIX:=0;

   WHILE PERMIX<GSIZE DO
    $(
    PERMIX+:=1;
    GPTR+:=COMPSZ+1;
    SEQIX:=0;
    WHILE SEQIX<COMPSZ DO
     $(
     SEQIX+:=1;
     COL:=WHICHCOL!SEQIX;
     ND:=COMP!COL;
     IMGND:=GROUP![GPTR+COL];
     IF ND=IMGND DO LOOP;
     PREVLIM:=SYMLIM!IMGND;
     TEST PREVLIM=0 THEN SYMLIM!IMGND:=ND
     OR IF SEQNO!ND>SEQNO!PREVLIM DO SYMLIM!IMGND:=ND;
     BREAK
     $)
    $)
   $)repcompon

 let UNREPCOMPON(COMPS) be
   $(unrepcompon
   OCOMP1:=COMP!1;
   COMPREC:=COMPS!COMPIX;
   COMP:=COMPREC!0;
   COMPSZ:=COMP!0;
   ND:=0;
   WHILE ND<COMPSZ DO
    $(eachNd
    ND+:=1;
    OSPTR+:=1;
    STACKPTR+:=1;
    OP:=STACK!OSPTR;
    P:=COMPINC(OP);
    SEQNO!P:=SEQNO!OP;
    STACK!STACKPTR:=P;
    SYMLIM!P:=COMPINC(SYMLIM!OP);
    OSPTR+:=3;
    STACKPTR+:=3;
    STACK![STACKPTR-2]:=STACK![OSPTR-2];
    STACK![STACKPTR-1]:=STACK![OSPTR-1];
    STACK!STACKPTR:=STACK!OSPTR;
    $(rpt
    OSPTR+:=1;
    STACKPTR+:=1;
    NBR:=STACK!OSPTR;
    IF NBR=0 DO $( STACK!STACKPTR:=0; BREAK $);
    TEST NBR>0 THEN STACK!STACKPTR:=COMPINC(NBR)
    OR
     $(anybnd
     STACK!STACKPTR:=-[COMPINC(-NBR)];
     OSPTR+:=1;
     STACKPTR+:=1;
     STACK!STACKPTR:=STACK!OSPTR
     $)anybnd
    $)rpt REPEAT
    $)eachNd
   SYMLIM![COMP!1]:=OCOMP1
   $)unrepcompon


 SEQNO:=NEWVEC(GSTOP-GSTART)-GSTART;
 WHICHCOL:=0;
 COMPIX:=0;
 NCOMP:=COMPS!0;

 /* It is possible for the substructure being injected to consist of
 more than one discrete component. Now work through each such component
 in turn.
 */

 WHILE COMPIX<NCOMP DO
  $(whCompix
  COMPIX+:=1;
  COMPREC:=COMPS!COMPIX
  TEST COMPREC!1 THEN REPCOMPON()
  OR UNREPCOMPON(COMPS)
  $)WhCompix

 STACKPTR+:=1;
 STACK!STACKPTR:=0;

 /* Clear up work space etc */
 UNLESS WHICHCOL=0 DO FREEVEC(WHICHCOL);
 FREEVEC(SEQNO+GSTART);
 ND:=GSTART-1;
 WHILE ND<GSTOP DO $( ND+:=1; MAPPEDTO!ND:=0 $);

//  OUTS("(in CREATEMATCHTABLE and SYMMETRY), SYMLIM data:*C*L")
//  OUTS("Node    SYMLIM*C*L")
//  for GG=GSTART to GSTOP do $( OUTNOS(GG); OUTNOL(SYMLIM!GG) $)

 /* Now know size of table giving data on how to do mapping of this
 substructure, allocate a vector and fill it in (using BLT to do
 actual copying out of STACK)
 */

 TABSZM1:=STACKPTR-STACKBOTTOM-1;
 TABL1:=NEWVEC(TABSZM1);
 BLT(STACK+STACKBOTTOM+1,TABL1,TABL1+TABSZM1);

 resultis TABL1

 $)csym


LET MAKEGLITAB(GSTART,GSTOP,GSCRATCH,NTYPES,TYPENUMS,SIGN) = VALOF $(MkGltb
/* 
	CODE TO TAKE INPUT SUBSTRUCTURAL PATTERN AND
CONVERT TO FORM IN WHICH CHECKS ARE MADE AGAINST PARTIALLY BUILT STRUCTURES.


	 Converts Pattern representation of a substructure into a GLITABLE
 representation that is designed to allow efficient graph matching
 against partial cases already built.

 Called by READPATS for each pattern read.

	MAKEGLITABLE returns a PATREC data structure, this has data defining
the atoms of the substructure and their matching order (lets call
it a MATCH-TABLE) along with details of the number and identity
of COUNT-EDGES and COUNT-NODES.
	MAKEGLITABLE involves the following main steps (originally all
as part of a single very large function, but now (1980) split into
seperate subroutines for greater ease of comprehension!):


1) SCOREANDCANONICALIZE():

   i) scoring of the atoms in the substructure.
  ii) using these scores in a canonicalization process that returns
	a COMPS data structure. This data-structure defines all
	the seperate subparts of the current GLI-item (which can
	of course consist of disconnected parts). Each entry
	in the COMPS data structure is a COMPREC with info on
	atoms, whether its unique or just a copy of another
	COMPREC also in current GLI-item.

2) CREATEMATCHTABLEANDSYMMETRY()
    Use the COMPS data to construct a MATCH-TABLE entry for
	each component along with symmetry restrictions on
	equivalent atoms.

3) FINDCOUNTNODESANDEDGES()
   Identify the COUNT-EDGES and COUNT-NODES that determine
	the meaning of the MIN/MAX occurrence limits associated with
	this GLI-item.
	


	The PATREC data structure returned consists of six elements:

  REC!0		Match-table
  REC!1		Number of COUNT-EDGES
  REC!2		Vector giving index numbers of first atom of each count edge
  REC!3		(similar, 2nd atom of edge, 2nd>1st)
  REC!4		Number of COUNT-NODES
  REC!5		Vector giving index numbers identifying COUNT-NODES


*/

STATIC $( 
COMPS = NIL; 
TABL = NIL; 
REC = NIL $);


//  OUTS("Entered MAKEGLITAB. Data defining pattern is:*C*L")
//  BUGTABLES(1,GSTART,GSTOP)
//  BUGTABLES(2,GSTART,GSTOP)
//  BUGTABLES(3,GSTART,GSTOP)


 COMPS:=SCOREANDCANONICALIZE(GSTART,GSTOP,GSCRATCH,NTYPES,TYPENUMS,SIGN)

//  OUTS("COMPS record built by SCOREANCANONICALIZE:*C*L")
//  BUGSYMTABLES(COMPS,TRUE)


 if COMPS=0 then $(err
	/* This is an unrecoverable error condition induced by excessive
	symmetry in a GLI-item making it impossible to represent
	its permutation symmetry group in space allocated. 
	Some more suitable error return will eventually have to be
	provided, for now --- just die.
	*/
	finish
	$)err

 TABL:=CREATEMATCHTABLEANDSYMMETRY(GSTART,GSTOP,COMPS)  
 FREECC(COMPS,TRUE);

 FINDCOUNTNODESANDEDGES(GSTART,GSTOP) 


//  OUTS("Next Pattern, nodes : "); OUTNOS(GSTART); OUTNOL(GSTOP)
//  OUTS("Symlim data:*C*L");
//  for III=GSTART to GSTOP $(
//    OUTNOS(III); OUTNOL(SYMLIM!III)
//    $)

 /* Now finally construct the complete record, its a 6 element
 vector with matching table, data on "count edges" (identification
 of these) and on "count nodes".
 */
 REC:=NEWVEC(5);
 REC!0:=TABL;
 REC!1:=NCE;
 REC!2:=CEN1;
 REC!3:=CEN2;
 REC!4:=NCN;
 REC!5:=CN;
 RESULTIS REC
 $)MkGltb

/*
		CODE FOR INPUT OF SUBSTRUCTURAL PATTERNS.
*/

LET FINDTYPE(STR) = VALOF
 $(
 /* Finds index number corresponding to string giving (next) atomtype
 possible for a node in a substructural pattern.
 There is a forced error return if somehow have inconsistent data
 and atom type used not one of those in initially defined set
 (should never happen as data validated before GLBLD is called,
 if it does occur, something has most likely corrupted data file
 and have got out of sequence in reading data, sometimes has
 occurred when people have looked at a file of substructures
 with an editor e.g. SOS that can leave strange characters behind).
 */
 FOR I=1 TO NTYPES DO IF STREQUAL(STR,TYPENAME!I) DO RESULTIS I;
 OUTS("UNKNOWN ATOM TYPE ");OUTS(STR);NEWLINE(1);
 EXECUTERETURN()
 $);

LET READPOLY(ATNUM) BE $(RDPLY
 /* Polyatoms are allowed, these appear in data stream in
 form of a parenthesised sequence of atom names.
 */

 STATIC $( INNAME = NIL; RP = NIL; LP = NIL; X = NIL; PNAME = NIL;
              OSZ = NIL; LOOPING = NIL; PHMIN = NIL; PHMAX = NIL;
              PHMINMIN = NIL; PHMAXMAX = NIL; STAR = NIL $);

   LET PUTATH(ATNUM) BE
      $(
      IF PHMIN<PHMINMIN DO PHMINMIN:=PHMIN;
      IF PHMAX>PHMAXMAX DO PHMAXMAX:=PHMAX
      $);

 RP:=")";
 LP:="(";
 STAR:="**";
 X:="X";
 PHMINMIN:=PLUSINF;
 PHMAXMAX:=0;
 OSZ:=NSETWDSM1;
 NSETWDSM1:=NTYPES>>P2WDSZ;
 PNAME:=ZEROSET(MAKESET());
 NSETWDSM1:=OSZ;
 LOOPING:=FALSE;


NAMELOOP:

 INNAME:=INS();
 IF STREQUAL(INNAME,RP) DO GOTO NAMEDONE;
 IF STREQUAL(INNAME,LP) DO $( LOOPING:=TRUE; GOTO NAMELOOP $);
 IF STREQUAL(INNAME,STAR) DO $( PUTELEM(0,PNAME); GOTO NAMELOOP $);
 PHMIN:=INNO();
 PHMAX:=INNO();
 TEST STREQUAL(INNAME,X) THEN
  FOR I=1 TO NTYPES DO $( PUTELEM(I,PNAME); PUTATH(I) $)
 OR
  $(
  INNAME:=FINDTYPE(INNAME);
  PUTELEM(INNAME,PNAME);
  PUTATH(INNAME)
  $);
 IF LOOPING DO GOTO NAMELOOP;

NAMEDONE:

 HMIN!ATNUM:=PHMINMIN;
 HMAX!ATNUM:=PHMAXMAX;
 ATTYPE!ATNUM:=PNAME
 $)RDPLY;





LET READPATS() BE
 $( STATIC $( OCTPTR = NIL; NBR = NIL; OSPTR = NIL; SIGN = NIL $);
 OSPTR:=STACKPTR;
 OCTPTR:=CTPTR;
 FIRSTCONSTRAINT:=TRUE
 FOR PAT=1 TO NUMPAT DO
  $(EachPAT
//   OUTSIF("CTABLE FOR PATTERN "); OUTNOIF(PAT);
//   OUTSIF(":*C*L");
  NPATNODES:=PATNNDS!PAT;
  FOR I=1 TO NPATNODES DO
   $( LET NDIX = PATSTOP+I;
   CTSTART!NDIX:=CTPTR;
   OUTNOIF(I); OUTCHIF(':'); OUTCHIF(' ');
   READPOLY(NDIX);
   ARTYPE!NDIX:=INNO();
 /* Modification to code, now have HYBRIDISATION tags rather like
 aromatic tags.
 */

   HYBRIDTYPE!NDIX:=INNO();

 /* Additional COLOUR tags added. */

   UMARKS!NDIX:=INNO()
   NBR:=INNO();
   UNTIL NBR=0 DO
    $(
    STACK!CTPTR:=(NBR<0 -> NBR-PATSTOP,NBR+PATSTOP);
    CTPTR+:=1;
    NBR:=INNO()
    $);
   CTSTOP!NDIX:=CTPTR-1
   $);

 /* Next two data items are essentially meaningless in GLBLD
 and remain merely to allow files to be more compatible in their
 formats. These data items are the number of LNODES (link nodes)
 (and defintion of the LNODES if there are any), and whether
 substructural pattern is to be treated as a "proton pattern" which
 modifies the counting scheme.
 Neither of these options are implemented.
 Get error returns here if find requests for either, but
 since data validated in calling program this should not happen.
 */

  IF INNO()>0 DO
   $(Lnodes
   OUTS("SORRY, I CAN'T HANDLE LNODES AT THE MOMENT*C*L");
   EXECUTERETURN();
   $)Lnodes

  IF STREQUAL("Y",INS()) DO
   $(YesProton
   OUTS("SORRY, I CAN'T HANDLE PROTON PATTERNS AT THE MOMENT*C*L");
   EXECUTERETURN();
   $)YesProton

  PATSTART:=PATSTOP+1;
  PATSTOP+:=NPATNODES;
  STACKPTR:=CTPTR;

/* Next two data items given minimum and maximum number of instances
  of this substructural pattern.
*/

  PATMINS!PAT:=INNO();
  PATMAXS!PAT:=INNO()


 /* Now, take data just read in and convert it into special
 record used when matching patterns to partially assembled "CASES".

 CURRENTLY, FIDDLING WITH SCORING FUNCTIONS, IN SOME SITUATIONS
 WANT SCORES COMPUTED BY "PNODESCORE" (MEASURES OF UNIQUENESS) TO
 BE USED TO RANK UNUSUAL ATOMS FIRST (THEN NEED -VE SIGN ON THESE SCORES)
 OTHERTIMES, WANT MORE COMMON ATOMS FIRST.
 */

  SIGN:=-1
  if FIRSTCONSTRAINT & PATMINS!PAT>1 then SIGN:=1
  FIRSTCONSTRAINT:=FALSE

  PATRECS!PAT:=
   MAKEGLITAB(PATSTART,PATSTOP,GSCRATCH,NTYPES,TYPENUM,SIGN);
  STACKPTR:=OSPTR;

  

/* NOW, get SCORE associated with this pattern. */
  SUBSCORES!PAT:=INNO()
  $)EachPAT;
 CTPTR:=OCTPTR
 $);
$NOLIST
//MACHINE-DEPENDENT FUNCTIONS FOR UNBUFFERED RANDOM-ACCESS I/O.
//USED FOR PUTTING AND GETTING STRUCTURES ON RANIO.TMP FOR
//DUPLICATE ELIMINATION DURING IMBEDDING.
//THE VARIABLES RANIOCHAN AND BLKSIZE ARE MANIFESTS ASSUMED TO BE
//DECLARED.  THE FUNCTION OUTS IS THE ONLY CALLED FUNCTION NOT DECLARED HERE.
LET BLOCKOUT(BLOCK,BLKPTR) BE
 $[ $USETO RANIOCHAN,@BLKPTR;
    $MOVEI 2,-1;
    $ADD 2,BLOCK;
    $HRLI 2,-BLKSIZE;
    $SETZ 3,0;
    $OUTPUT RANIOCHAN,2;
    $SETZM 0,@BLOCK;
    $( BLT(BLOCK,BLOCK+1,BLOCK+BLKSIZE-1) $)
 $];

LET BLOCKIN(BLOCK,BLKPTR) BE $(BLKIN
 PAGING+:=1

 $[ $USETI RANIOCHAN,@BLKPTR;
    $MOVEI 2,-1;
    $ADD 2,BLOCK;
    $HRLI 2,-BLKSIZE;
    $SETZ 3,0;
    $INPUT RANIOCHAN,2;
 $]
$)BLKIN

LET RANIOINIT(RANFILE,RANEXT) BE
 $( STATIC $( FNAME = NIL; FEXT = NIL $);
 FNAME:=SIXBIT(RANFILE);
 FEXT:=SIXBIT(RANEXT);
 $[ $MOVEI 2,#17;
    $HRLZI 3,#446353;      // OCTAL FOR SIXBIT/DSK/
    $SETZ 4,0;
    $OPEN RANIOCHAN,2;
    $JRST ERROUT;
    $MOVE 2,FNAME;
    $MOVE 3,FEXT;
    $SETZ 4,0;
    $SETZ 5,0;
    $ENTER RANIOCHAN,2;
    $JRST ERROUT;
    $CLOSE RANIOCHAN,0;
    $MOVE 2,FNAME;
    $MOVE 3,FEXT;
    $SETZ 4,0;
    $SETZ 5,0;
    $LOOKUP RANIOCHAN,2;
    $JRST ERROUT;
    $ENTER RANIOCHAN,2;
    $JRST ERROUT;
    $( RETURN $);
    ERROUT:
    $( FINISH $)
 $]
 $);

LET RANIOTERMINATE(RANFILE,RANEXT) BE $[ $CLOSE RANIOCHAN,0 $];
$LIST
LET ORBREP(ND) = VALOF $(rbrp

 /*
	This function handles "smallness from the CONGEN problem side" ---
 i.e. getting a symmetry representative.

     GLI        CONGEN-problem
------------+------------------
  nodes	    |	  ***
   indexed  |      *    (1-m) nodes
     1-n    |
	    |
   ***	    |   **
    **	    |
   **	    |	  *


	Want a mapping of GLI nodes onto CONGEN nodes that cannot be made
 smaller by any combination of either GLI or CONGEN symmetries (i.e.
 double coset representative). Can't do this but can handle left/right
 symmetries individually. This code concerned with symmetry of CONGEN
 part.

	1) Consider some node on the CONGEN side,

		It is the representative node if
	
		a) its in the representative version of the component
		of which it is a part (remember that have already
		perceived equivalent components and identified one
		as representative one)

		b) within the current (representative) component it
		must be the representative node of those in its orbit.

	2) Once have found representative node, then 
		must use the DISL (disabled symmetries) fields etc to
		modify the group within this component, and also record
		that must have a new representative for the class
		of components.


	ORBREP returns -ve value if ND is not a representative on
 the CONGEN side, otherwise returns size of group in component before
 this node picked out (that gets stacked away somewhere and used to
 correct representation of group once have finished with exploring assignment
 of ND)


 */

 STATIC $( COMPREC = NIL; DISL = NIL; GROUP = NIL; OLDNG = NIL;
              NOBJ = NIL; NOBP1 = NIL; GCOUNT = NIL; GPTR = NIL;
              OFFST = NIL; NEWNG = NIL; COMPARISON = NIL $);
 IF NOBUILD DO RESULTIS 0;

 /* First get at record that describes the component containing this node. */
 COMPREC:=PARENTCOMP!ND;

 /* First element of COMPREC is a flag that says that this is the
 representative example of such components, if its not then this
 node is not appropriate. */

 UNLESS COMPREC!1 DO RESULTIS -1;


 /* Otherwise start looking at symmetry group, some symmetries may already
 have been "disabled" by previous selections of atoms from the component. */

 DISL:=COMPREC!3+1;
 GROUP:=COMPREC!4;
 OLDNG:=GROUP!0;
 UNLESS OLDNG=0 DO
  $(
  NOBJ:=[COMPREC!0]!0;
  NOBP1:=NOBJ+1;
  GCOUNT:=0;
  GPTR:=-NOBJ;
  OFFST:=COMPOFFSET!ND;
  NEWNG:=0;
  WHILE GCOUNT<OLDNG DO
   $(
   GPTR+:=NOBP1;
   IF 0<GROUP!GPTR<DISL DO LOOP;
   GCOUNT+:=1;
   COMPARISON:=OFFST-COMPOFFSET![GROUP![GPTR+OFFST]];
   IF COMPARISON>0 DO RESULTIS -1;
   GROUP!GPTR:=(COMPARISON=0 -> 0,DISL)
   NEWNG+:=(COMPARISON=0 -> 1,0)
   $);
  GROUP!0:=NEWNG
  $);
 IF DISL=1 DO
  IF COMPREC!2 NE 0 DO
   [COMPREC!2]!1:=TRUE;
  COMPREC!3:=DISL;
 RESULTIS OLDNG
 $)rbrp



LET UNORBREP(ND,OLDNG) BE $(nrbrp
 STATIC $( COMPREC = NIL; GROUP = NIL; DISL = NIL $);
 IF NOBUILD DO RETURN;

 /* Last selection of a node as an orbit representative of a component
 modified the symmetry group for the component, the symmetry group
 should be restored to what it was before that selection made.
 */

 COMPREC:=PARENTCOMP!ND;
 GROUP:=COMPREC!4;
 GROUP!0:=OLDNG;
 DISL:=COMPREC!3-1;
 COMPREC!3:=DISL;
 IF DISL=0 DO
  IF COMPREC!2 NE 0 DO
   [COMPREC!2]!1:=FALSE
 $)nrbrp

LET WRITECGP() BE $(wrcgp
 STATIC $( ND = NIL; PTR = NIL; PTRTOP = NIL; NBR = NIL $);
 OUTPUT:=OUTFILE;
 OUTCH(46);
 OUTNOS(NSTRUCS);
 UNLESS GENERATING DO $( OUTNOS(NEWBELIEF); OUTNOS(NEWDISBELIEF) $);
 ND:=CGPSTART-1;
 WHILE ND<CGPSTOP DO
  $(whND
  ND+:=1;
  TEST GENERATING THEN 
	IF ARTYPE!ND=2 DO $( AROMWARN:=TRUE; OUTCH([ARSYM+48] REM 128) $)
  OR
   $(NTGN
   static $( COLOUR1 = NIL; COLOUR2 = NIL $)
   OUTCH([CGPNDSYM+48] REM 128);
   OUTCH([ARTYPE!ND+48] REM 128);
   OUTCH([HYBRIDTYPE!ND+48] REM 128);
   COLOUR1:=(UMARKS!ND BITAND #7700) >> 6
   COLOUR2:=(UMARKS!ND BITAND #77)
   OUTCH([COLOUR1+48] REM 128);
   OUTCH([COLOUR2+48] REM 128);
   OUTCH([HMIN!ND+48] REM 128);
   OUTCH([HMAX!ND+48] REM 128)
   $)NTGN
  PTR:=CTSTART!ND-1;
  PTRTOP:=CTSTOP!ND;
  WHILE PTR<PTRTOP DO
   $(nbrs
   PTR+:=1;
   NBR:=CTABLE!PTR;
   TEST NBR>0 THEN OUTCH([NBR+48] REM 128)
   OR
    TEST NBR=0 THEN OUTCH([CTABLE![PTR-1]+48] REM 128)
    OR $( OUTCH([48-NBR] REM 128); OUTCH([ANYBSYM+48]REM 128) $)
   $)nbrs
  OUTCH(48)
  $)whND
 OUTCH(47);
 OUTPUT:=TTY;
 OUTCHP('.')
 $)wrcgp


LET UNIQUECGP() = VALOF $(nqcgp
 STATIC $( NUMBERING = NIL; ND = NIL; IMGND = NIL; PTR = NIL; NNBRS = NIL;
              IMGNBRS = NIL; INBR = NIL; IMGNBR = NIL; NBRIX = NIL; TEM = NIL;
              NEBPTR = NIL; EBWD = NIL; EBWDIX = NIL; KEY = NIL; INDEX = NIL;
              NXEBPTR = NIL; SYM = NIL; NBR = NIL; NARNBRS = NIL;
              NUNBRS = NIL; NANY = NIL; COMPS = NIL; NCOMP = NIL;
              COMPIX = NIL; COMP = NIL; COMPSZ = NIL; NDIX = NIL;
              MBIX = 0; PTRTOP = NIL $);
//FEB. 13, 1979
//WRITTEN BY RAY CARHART.  THESE ARE AUXILLARY FUNCTIONS
//FOR EMBFUN.
//>
//>VECCOMP COMPARES (LEXICALLY) VECTORS V1 AND V2, RETURNING 1 (0, -1) IF V1 IS
//>GREATER THAN (EQUAL TO, LESS THAN) V2.  COMPARISON BEGINS AT THE ZEROTH(!)
//>WORD AND PROCEEDS TO AT MOST THE (NWDS-1)TH WORD.  NWDS IS THUS THE MAXIMUM
//>NUMBER OF ELEMENTS TO BE COMPARED.
//>
LET VECCOMP(V1,V2,NWDS) = VALOF $(Vccmp
 STATIC $( IX = NIL $);
 IX:=0;

 WHILE IX<NWDS DO
  $(whix
  IF V1!IX NE V2!IX DO RESULTIS (V1!IX>V2!IX -> 1,-1);
  IX+:=1
  $)whix

 RESULTIS 0
 $)Vccmp

//>
//>KEYSEARCH FINDS WHERE THE INTEGER KEY IS (OR BELONGS) IN KEYLIST.
//>KEYLIST IS A VECTOR, WITH KEYLIST!KFSTART,...,KEYLIST!SSSIZE FILLED WITH
//>A NON-DECREASING SEQUENCE OF INTEGERS.  KEYLIST!SSSIZE CONTAINS
//>PLUSINF, THE LARGEST POSITIVE INTEGER REPRESENTABLE ON THIS MACHINE.
//>KEYSEARCH RETURNS THE SMALLEST INDEX, SPTR, SUCH THAT KEY IS LESS THAN OR
//>EQUAL TO KEYLIST!SPTR.  LOOSELY SPEAKING, THE VALUE REPRESENTS "WHERE
//>THE INTEGER KEY BELONGS" IN KEYLIST.  SPTR IS FOUND VIA A STANDARD BINARY
//>SEARCH.
//>
//>THE KEYLIST ENTRIES ARE NON-DECREASING, BUT SUCCESSIVE ENTRIES MAY BE
//>EQUAL.
//>
LET KEYSEARCH(KEY) = VALOF $(kysrch
 STATIC $( SSTART = NIL; SSTOP = NIL; SPTR = NIL $);

 IF KEY LE KEYLIST!KFSTART DO 
		RESULTIS KFSTART;


 IF KEY>KEYLIST![SSSIZE-1] DO 
		RESULTIS SSSIZE;

 SSTART:=KFSTART;
 SSTOP:=SSSIZE;


SEARCHLOOP:

 SPTR:=[SSTART+SSTOP]>>1;
 IF SPTR=SSTART DO 
	RESULTIS SPTR+1;

 TEST KEYLIST!SPTR<KEY THEN SSTART:=SPTR 
		       OR SSTOP:=SPTR;

 GOTO SEARCHLOOP

$)kysrch

//>
//>STRUCEQUAL IS RESPONSIBLE FOR COMPARING THE JUST-CREATED STRUCTURE, STORED
//>AS A SEQUENCE OF WORDS OF LENGTH STRUCSZ AND BEGINNING AT LOCATION
//>(LASTBLOCK+EBPTR), WITH A PREVIOUSLY-CREATED STRUCTURE STORED ON
//>THE RANDOM-ACCESS FILE.  FILIX IS A DESCRIPTION OF THE LOCATION OF THIS
//>PREVIOUS STRUCTURE, CONTAINING BOTH BLOCKIX (THE ADDRESS OF THE BLOCK IN
//>WHICH THE STRUCTURE IS STORED ON THE FILE) AND BLOCKPTR (THE STARTING
//>ADDRESS OF THE STRUCTURE WITHIN THAT BLOCK).  THE ACTUAL FORM OF FILIX
//>IS BLOCKIX*BLKSIZE+BLOCKPTR, WHERE BLKSIZE IS THE SIZE OF THE BLOCKS
//>WRITTEN TO AND READ FROM THE RANDON-ACCESS FILE.
//>
//>THERE ARE THREE POSSIBLE CASES HERE.  1) IF BLOCKIX=BLOCKCOUNT, THE OLD
//>STRUCTURE HAS NOT BEEN WRITTEN TO THE FILE YET, BUT IS IN LASTBLOCK ALONG
//>WITH THE NEW STRUCTURE.  IN THIS CASE THE COMPARISON IS CARRIED OUT BY
//>SIMPLY COMPARING TWO SEGMENTS OF LASTBLOCK.  2) IF BLOCKIX=MBIX, THEN THE
//>DESIRED BLOCK ALREADY RESIDES IN CORE (MIDBLOCK IS THE VECTOR INTO WHICH
//>BLOCKS ARE READ FROM THE FILE, AND MBIX IS THE INDEX OF THE MOST RECENTLY
//>READ BLOCK).  IN THIS CASE, NO READING IS NECESSARY, BUT THE COMPARISON IS
//>NOW BETWEEN A SEGMENT OF MIDBLOCK AND A SEGMENT OF LASTBLOCK.  3) IF NEITHER
//>OF THESE SPECIAL CASES PERTAINS, THE DESIRED BLOCK IS READ INTO MIDBLOCK
//>USING THE FUNCTION BLOCKIN, MBIX IS UPDATED TO BLOCKIX, AND THE COMPARISON
//>TAKES PLACE AS IN CASE 2.
//>
//>THE REPRESENTATION FOR IMBEDDED STRUCTURES IS SUCH THAT EVERY ONE OF THEM
//>OCCUPIES THE SAME NUMBER OF WORDS (STRUCSZ), SO THIS VALUE IS USED IN ALL
//>CALLS TO VECCOMP BELOW.
//>
//>THE VALUE OF STRUCEQUAL IS TRUE IF THE COMPARED STRUCTURES ARE EQUAL, FALSE
//>IF NOT.
//>
LET STRUCEQUAL(FILIX) = VALOF $(strcql
 STATIC $( BLOCKIX = NIL; BLOCKPTR = NIL $);
 BLOCKIX:=FILIX/BLKSIZE;
 BLOCKPTR:=FILIX REM BLKSIZE;

 IF BLOCKIX=BLOCKCOUNT DO
	  RESULTIS VECCOMP(LASTBLOCK+BLOCKPTR,LASTBLOCK+EBPTR,STRUCSZ)=0;

 IF BLOCKIX NE MBIX DO $( BLOCKIN(MIDBLOCK,BLOCKIX); MBIX:=BLOCKIX $);

 RESULTIS VECCOMP(MIDBLOCK+BLOCKPTR,LASTBLOCK+EBPTR,STRUCSZ)=0

$)strcql

//>
//>STRUCSCAN BRINGS TOGETHER THE ACTIONS OF KEYSEARCH AND STRUCEQUAL FOR THE
//>PURPOSE OF ELIMINATING DUPLICATE IMBEDDED STRUCTURES.  THE BASIC STRUCTURE
//>OF KEYLIST HAS BEEN DESCRIBED ABOVE IN KEYSEARCH; THE KEYS THEMSELVES ARE
//>ANY INTEGERS REPRESENTING TOPOLOGICAL INVARIANTS OF THE UNIQUE STRUCTURES
//>WHICH HAVE ALREADY BEEN ENCOUNTERED IN THE OVERALL IMBEDDING PROBLEM.  IN
//>THIS IMPLEMENTATION, A KEY IS JUST A HASHED INTEGER OBTAINED BY "SQUASHING"
//>THE CANONICAL CONNECTION TABLE INTO A SINGLE WORD.  THE FILIXLIST VECTOR
//>PARALLELS KEYLIST, BUT INSTEAD OF CONTAINING A KEY FOR EACH UNIQUE
//>STRUCTURE, IT CONTAINS THE CORRESPONDING FILIX POINTER (SEE STRUCEQUAL,
//>ABOVE) TELLING WHERE THE STRUCTURE OCCURS IN THE RANDOM-ACCESS FILE.
//>
//>USING KEYSEARCH, STRUCSCAN LOCATES THE LOWEST POSITION IN THE SORTED KEYLIST
//>WHOSE VALUE IS GREATER THAN EQUAL TO KEY, THE KEY FOR THE CURRENT STRUCTURE.
//>ALL SUBSEQUENT POSITIONS IN KEYLIST LIKEWISE HAVE VALUES GREATER THAN OR
//>EQUAL TO KEY, BECAUSE KEYLIST IS NON-DECREASING.  STRUCSCAN THEN SCANS
//>SUCCESSIVELY HIGHER POSITIONS OF KEYLIST, AT EACH POINT COMPARING THE
//>VALUE TO KEY.  IF THE VALUE EQUALS KEY, THEN STRUCEQUAL IS CALLED WITH THE
//>CORRESPONDING FILIX TO DETERMINE WHETHER THE NEW STRUCTURE IS EQUAL TO
//>THE OLD, UNIQUE ONE (HIGHLY LIKELY, IF THE KEYS ARE GOOD DISCRIMINATORS OF
//>STRUCTURE).  IF THE STRUCTURES ARE EQUAL, STRUCSCAN RETURNS -1 TO INDICATE
//>THAT THE NEW STRUCTURE IS A DUPLICATE, AND IF THE STRUCTURES ARE NOT EQUAL,
//>THE SCAN JUST CONTINUES.  IF THE VALUE IN KEYLIST IS LARGER THAN KEY, THEN
//>THE NEW STRUCTURE IS UNIQUE, AND THE CURRENT KEYLIST POSITION (SPTR) TELLS
//>WHERE THE KEY (AND FILIX) FOR THE NEW STRUCTURE SHOULD BE INSERTED IN
//>KEYLIST (AND FILIXLIST).  THE SPTR VALUE RETURNED BY STRUCSCAN IN THIS CASE
//>IS ACTUALLY THE POSITION *BEFORE WHICH* THE NEW KEY SHOULD BE INSERTED.
//>
//>THE SCAN WILL ALWAYS TERMINATE BECAUSE THE LAST LOCATION OF KEYLIST CONTAINS
//>PLUSINF, THE LARGEST POSITIVE INTEGER ON THIS MACHINE, AND IN EMBFUN
//>THE COMPUTED KEYS ARE NEVER ALLOWED TO ACTUALLY EQUAL PLUSINF (SPECIFICALLY,
//>A KEY WHICH COMES OUT AS PLUSINF HAS 1 SUBTRACTED FROM IT).
//>
LET STRUCSCAN(KEY) = VALOF $(stcscn
 STATIC $( SPTR = NIL $);
 SPTR:=KEYSEARCH(KEY);
  $(rpt
  IF KEYLIST!SPTR>KEY DO RESULTIS SPTR;
  IF STRUCEQUAL(FILIXLIST!SPTR) DO RESULTIS -1;
  COLLISIONCOUNT+:=1
  SPTR+:=1
  $)rpt REPEAT
 $)stcscn

//>
//>INSERTBEFORE(INDEX,KEY,FILIX) INSERTS KEY IN KEYLIST AND FILIX IN FILIXLIST
//>IMMEDIATELY BEFORE POSITION INDEX.
//>
//>NOTE THAT KEYLIST AND FILIXLIST GROW "FROM THE BOTTOM" - THAT IS, THEIR
//>HIGHEST LOCATION IS ALWAYS SSSIZE, BUT THEIR LOWEST LOCATION (KFSTART)
//>BECOMES SMALLER AS ELEMENTS ARE ADDED.  THIS WAS A FAIRLY MACHINE-DEPENDENT
//>DECISION BECAUSE IT ALLOWS EFFICIENT USE TO BE MADE OF THE "BLT"
//>(BLOCK TRANSFER) INSTRUCTION ON THE PDP-10, WHICH TRANSFERS THE CONTENTS OF
//>A VECTOR FROM ONE PLACE IN MEMORY TO ANOTHER, STARTING WITH THE FIRST
//>ELEMENT AND WORKING ITS WAY UP.  OTHER MACHINES HAVE BLOCK TRANSFER
//>INSTRUCTIONS, BUT IF THEY MOVE A VECTOR STARTING AT THE HIGHEST LOCATION
//>RATHER THAN THE LOWEST, THEN KEYLIST AND FILIXLIST SHOULD GROW "FROM
//>THE TOP". 
//>
//>IT IS THE RESPONSIBILITY OF WHOEVER CALLS INSERTBEFORE TO VERIFY THAT THESE
//>LISTS ARE NOT ALREADY FULL (I.E., THAT KFSTART IS GREATER THAN ZERO UPON
//>ENTRY).  THE ONLY ERROR PROTECTION PROVIDED HERE IS THE MESSAGE WHICH GETS
//>PRINTED BELOW WHEN THE LATEST ENTRY FILLS THE LISTS.
//>
LET INSERTBEFORE(INDEX,KEY,FILIX) BE $(nsrtbfr
 TEST INDEX=KFSTART THEN
  $(tstndx
  KFSTART-:=1;
  KEYLIST!KFSTART:=KEY;
  FILIXLIST!KFSTART:=FILIX
  $)tstndx
 OR
  $(ortstndx
  STATIC $( NEWSTART= NIL; IXM1 = NIL; IXM2 = NIL $);
  NEWSTART:=KFSTART-1;
  IXM1:=INDEX-1;
  IXM2:=IXM1-1;
  BLT(KEYLIST+KFSTART,KEYLIST+NEWSTART,KEYLIST+IXM2);
  KEYLIST!IXM1:=KEY;
  BLT(FILIXLIST+KFSTART,FILIXLIST+NEWSTART,FILIXLIST+IXM2);
  FILIXLIST!IXM1:=FILIX;
  KFSTART:=NEWSTART
  $)ortstndx
 IF KFSTART>0 DO RETURN;
 OUTS("*C*LTHE LIST I USE FOR AVOIDING DUPLICATE STRUCTURES IS NOW FULL*C*L");
 OUTS("THERE MAY BE DUPLICATION AMONG STRUCTURES WITH INDICES ABOVE ");
 OUTNOL(NSTRUCS);
 TERMPOSITION:=0
 $)nsrtbfr

//>
//>PUTSYM IS USED TO "WRITE DOWN" THE NEW STRUCTURE IN LASTBLOCK.  THE STRUCTURE
//>IS REPRESENTED AS A STRING OF SYMBOLS, WITH SYMSIZE BITS PER SYMBOL, PACKED
//>SEQUENTIALLY WITH SYMSPERWD SYMBOLS IN A WORD.  THE FINAL WORD OF A STRUCTURE
//>IS PACKED WITH TRAILING ZEROS TO FILL THE WORD, IF NECESSARY (THIS IS
//>ACTUALLY DONE BY EMBFUN BY CALLING PUTSYM(0) AS NECESSARY - I MENTION IT HERE
//>ONLY TO CLARIFY THE CONTEXT IN WHICH PUTSYM IS USED).
//>
//>SYM IS AN INTEGER REPRESENTING THE SYMBOL TO BE PLACED NEXT.  EBWD ("LASTBLOCK
//>WORD") STORES THE WORD OF LASTBLOCK WHICH IS CURRENTLY BEING "PACKED", AND
//>NEBPTR POINTS TO THE LASTBLOCK LOCATION WHICH IS TO RECEIVE EBWD WHEN EBWD HAS
//>GOTTEN SYMSPERWD SYMBOLS PACKED INTO IT.  EBWDIX COUNTS THE NUMBER OF SYMBOLS
//>WHICH HAVE ALREADY BEEN PLACED IN EBWD.
//>
//>SYM IN INCORPORATED INTO EBWD BY SHIFTING EBWD LEFT BY SYMSIZE BIT POSITIONS
//>THEN OR-ING IN THE VALUE OF SYM ("EXCLUSIVE OR" IS USED - THE NEQV OPERATOR).
//>EBWDIX IS INCREMENTED AND IF THE INCREMENTED VALUE IS STILL LESS THAN
//>SYSMSPERWD, NOTHING FURTHER NEEDS TO BE DONE FOR THIS SYM (WE IGNORE
//>FOR THE MOMENT THE COMPUTATION INVOLVING THE KEY).  IF THE INCREMENTED
//>EBWDIX EQUALS SYMSPERWD, EBWD IS PLACED IN LOCATION NEBPTR,
//>NEBPTR IS INCREMENTED, AND EBWD AND EBWDIX ARE BOTH SET BACK TO ZERO.
//>
//>AS A PARALLEL ACTIVITY, PUTSYM IS RESPONSIBLE FOR COMPUTING THE KEY WHICH
//>IS USED AS A STRUCTURE DISCRIMINATOR TO AID IN ELIMINATING DUPLICATE
//>IMBEDDED STRUCTURES.  KEY IS INITIALIZED (BY EMBFUN) TO ZERO BEFORE ANY 
//>SYMBOLS ARE PLACED FOR THE STRUCTURE.  AS EACH SYMBOL IS PLACED, IT IS
//>(EXCLUSIVE)OR-ED INTO THE KEY, AND THE KEY IS ROTATED BITWISE TO THE
//>LEFT (THE ROTL OPERATION) BY A NUMBER OF POSITIONS EQUAL TO KEYROT.  THE
//>SYMBOLS WHICH MAKE UP THE REPRESENTATION OF THE STRUCTURE ARE THUS
//>"MIXMASTERED" INTO A SINGLE INTEGER, AND AS LONG AS THE REPRESENTATION
//>IS A CANONICAL ONE, THE KEY THUS PRODUCED WILL BE A TOPOLOGICAL PROPERTY
//>OF THE STRUCTURE.  STRUCTURES WITH DIFFERENT KEYS ARE NECESSARILY NON-
//>EQUIVALENT TOPOLOGICALLY, WHILE STRUCTURES WITH THE SAME KEY MAY OR
//>MAY NOT BE EQUIVALENT 
//>
LET PUTSYM(SYM) BE $(ptsym
 EBWD:=[EBWD << SYMSIZE] NEQV SYM;
 EBWDIX+:=1;
 KEY:=[KEY ROTL KEYROT] NEQV SYM;

 IF EBWDIX<SYMSPERWD DO RETURN;

 LASTBLOCK!NEBPTR:=EBWD;
 NEBPTR+:=1;
 EBWD:=0;
 EBWDIX:=0
 $)ptsym


 LET XTIME = 0;

//   XTIME:=MSRUNTIME()

COUNTUNIQUECGP+:=1;

 NXEBPTR:=EBPTR+STRUCSZ;
 IF NXEBPTR>BLKSIZE DO
  $(ifNXEBPTR
  BLOCKOUT(LASTBLOCK,BLOCKCOUNT);
  BLOCKCOUNT+:=1;
  EBPTR:=0;
  NXEBPTR:=STRUCSZ
  $)ifNXEBPTR

 EBWD:=0;
 EBWDIX:=0;
 KEY:=0;
 NEBPTR:=EBPTR;

 /* Minor problem re canonicalization, if 'GENERATING' then we intend
 to throw away the hybridtype and colour properties of nodes. Can't do
 this before the generating and limit testing steps for some of
 the constraints still applicable when generating may involve such
 properties. However, don't want to use these properties to determine
 numbering. They form the last two props in CGPATPROPS, eliminate
 them temporarily.
 */
 if GENERATING then CGPATPROPS!0:=5;
 COMPS:=CANONCOMPS(CGPSTART,CGPSTOP,CGPATPROPS,0);
 /* now restore CGPATPROPS. */
 if GENERATING then CGPATPROPS!0:=7;

 NUMBERING:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;
 NCOMP:=COMPS!0;
 IMGND:=0;
 COMPIX:=0;
//  OUTS("Canonical numbering of derived structure:*C*L")
//  OUTS("Node    Sequence # *C*L")

 WHILE COMPIX<NCOMP DO
  $(whCOMPIX
  COMPIX+:=1;
  COMP:=[COMPS!COMPIX]!0;
  COMPSZ:=COMP!0;
  NDIX:=0;

  WHILE NDIX<COMPSZ DO
   $(whNDIX
   NDIX+:=1;
   IMGND+:=1;
   NUMBERING![COMP!NDIX]:=IMGND
//  OUTNOS([COMP!NDIX]); OUTNOL(IMGND)

   $)whNDIX

  $)whCOMPIX

 IMGND:=0;
 COMPIX:=0;

 WHILE COMPIX<NCOMP DO
  $(whCOMPIX
  COMPIX+:=1;
  COMP:=[COMPS!COMPIX]!0;
  COMPSZ:=COMP!0;
  NDIX:=0;

  WHILE NDIX<COMPSZ DO
   $(whNDIX
   NDIX+:=1;
   IMGND+:=1;
   IMGNBRS:=STACK+STACKPTR;
   ND:=COMP!NDIX;
   PUTSYM(ATTYPE!ND);

   TEST GENERATING THEN IF ARTYPE!ND=2 DO PUTSYM(ARSYM)
   OR
    $(NTGN
    PUTSYM(ARTYPE!ND);
  PUTSYM(HYBRIDTYPE!ND);
   PUTSYM((UMARKS!ND BITAND #7700) >> 6)
   PUTSYM(UMARKS!ND BITAND #77)
    PUTSYM(HMIN!ND);
    PUTSYM(HMAX!ND)
    $)NTGN

   PTR:=CTSTART!ND-1;
   PTRTOP:=CTSTOP!ND;
   NARNBRS:=0;
   NUNBRS:=0;
   NANY:=0;
   INBR:=0;
   UNTIL PTR=PTRTOP DO
    $(NtlPTR
    PTR+:=1;
    NBR:=CTABLE!PTR;

    IF NBR=0 DO $( 
		NARNBRS+:=1; 
		LOOP 
		$)

    TEST NBR>0 THEN IMGNBR:=NUMBERING!NBR
    OR
     $(NBRLS0
     IMGNBR:=NUMBERING![-NBR];
     IF IMGNBR>IMGND DO LOOP;
     IMGNBR:=-IMGNBR;
     NANY+:=1
     $)NBRLS0

    NUNBRS+:=1;
    NBRIX:=1;
    WHILE NBRIX<NUNBRS DO
     $(whnbrix

     IF IMGNBRS!NBRIX>IMGNBR DO
      $(ifIMGNBRS
      TEM:=IMGNBRS!NBRIX;
      IMGNBRS!NBRIX:=IMGNBR;
      IMGNBR:=TEM
      $)ifIMGNBRS

     NBRIX+:=1
     $)whnbrix
    IMGNBRS!NUNBRS:=IMGNBR
    $)NtlPTR

   NNBRS:=NUNBRS+NARNBRS;
   INBR:=0;
   UNTIL INBR=NANY DO
    $(ntlINBR
    INBR+:=1;
    PUTSYM(ANYBSYM);
    PUTSYM(-[IMGNBRS!INBR])
    $)ntlINBR
   UNTIL INBR=NUNBRS DO
    $(ntlINBR
    INBR+:=1;
    PUTSYM(IMGNBRS!INBR)
    $)ntlINBR
   UNTIL INBR=NNBRS DO
    $(ntlINBR
    INBR+:=1;
    PUTSYM(ARSYM)
    $)ntlINBR
   PUTSYM(ROWTERM);
   $)whNDIX
  $)whCOMPIX

 WHILE NEBPTR<NXEBPTR DO PUTSYM(0);
 FREEVEC(NUMBERING+CGPSTART);
 FREECC(COMPS,FALSE);
 IF KEY=PLUSINF DO KEY-:=1;
 INDEX:=STRUCSCAN(KEY);

 IF INDEX<0 DO $(dupl
	OUTCHP('D'); 

//  	TIMINGS!TIMEUNIQUE+:=MSRUNTIME()-XTIME

	RESULTIS FALSE 
	$)dupl

 NSTRUCS:=NSTRUCS+1;

 IF KFSTART>0 DO
  $(KFSTRT
  INSERTBEFORE(INDEX,KEY,BLOCKCOUNT*BLKSIZE+EBPTR);
  EBPTR:=NXEBPTR
  $)KFSTRT

//   TIMINGS!TIMEUNIQUE+:=MSRUNTIME()-XTIME

 RESULTIS TRUE
 $)nqcgp


LET ADDMATCH() = VALOF $(Addmtch
 STATIC $( THISMATCH = NIL; IX = NIL; MTOP = NIL; MPTR = NIL;
              N1 = NIL; N2 = NIL; TEM = NIL; TM1 = NIL;
              TM2 = NIL; MPTR2 = NIL; IMATCH = NIL; OLDMATCH = NIL;
              SAMEAS = NIL $);
 /* MAXMATCH is one more than the number of instances of the substructure
 that we need. So if MAXMATCH=1, we want NONE but have one.
 No more then need be done.
 */

 IF MAXMATCH=1 DO $( NMATCH:=1; RESULTIS TRUE $);

 /* Otherwise we must determine the number of distinct matches, so
 a data structure is built (MATCHES) each element of which is a
 vector defining a particular matching of the pattern (GLI-item)
 to the structure (CGP-CONGENPROBLEMPART).
 It is in this process of building the data structure for
 a given match that we have to consider what it is that we are counting.
 */

 THISMATCH:=NEWVEC(MCHSIZ);
 IX:=0;
 MTOP:=-1;
 WHILE IX<NCE DO
  $(whIX
  /* Fill in data defining "Count Edges", these get ordered so that
  say the bonds in the CGP used were (4,3) and (2,1) then first
  arrange them as (3,4) (1,2) then when adding the second one (1,2)
  rearrange data in THISMATCH so that it reads 1,2,3,4
  */

  MTOP+:=2;
  MPTR:=1;
  IX+:=1;
  N1:=MAPPEDTO![CEN1!IX];
  N2:=MAPPEDTO![CEN2!IX];
  IF N1>N2 DO $( TEM:=N1; N1:=N2; N2:=TEM $);
  WHILE MPTR<MTOP DO
   $(whMPTR
   /* This code merely finds where should put data defining new N1-N2 bond
   (N1<N2) into THISMATCH. If we do find that it should be inserted before
   something already there then just bump everything up and put it in.
   */
   TM1:=THISMATCH!MPTR;
   TM2:=THISMATCH![MPTR+1];
   TEM:=N1-TM1;
   IF TEM=0 DO TEM:=N2-TM2;
   IF TEM>0 DO
    $(ifTEM
    THISMATCH!MPTR:=N1;
    THISMATCH![MPTR+1]:=N2;
    N1:=TM1;
    N2:=TM2
    $)ifTEM

   MPTR+:=2
   $)whMPTR

  THISMATCH!MPTR:=N1;
  THISMATCH![MPTR+1]:=N2
  $)whIX

 MPTR:=MTOP+1;
 IX:=0;

 WHILE IX<NCN DO
  $(CountNds
  /* Here we deal with "COUNT NODES". */

  MTOP:=MPTR+IX;
  MPTR2:=MPTR;
  IX+:=1;
  N1:=MAPPEDTO![CN!IX];
  WHILE MPTR2<MTOP DO
   $(findwhere
   MPTR2+:=1;
   TM1:=THISMATCH!MPTR2;
   IF N1 LE TM1 DO LOOP;
   THISMATCH!MPTR2:=N1;
   N1:=TM1
   $)findwhere

  THISMATCH![MPTR2+1]:=N1
  $)CountNds


 IMATCH:=0;
 WHILE IMATCH<NMATCH DO
  $(CompareOldMatches
  /* Loop through all previously found matches to see if we have 
  just created a duplicate of an existing match.
  */

  IMATCH+:=1;
  OLDMATCH:=MATCHES!IMATCH;
  SAMEAS:=TRUE;
  MPTR:=0;

  WHILE MPTR<MCHSIZ DO
   $(CmprNds
   MPTR+:=1;
   IF THISMATCH!MPTR NE OLDMATCH!MPTR DO $( SAMEAS:=FALSE; BREAK $)
   $)CmprNds

  /* If this match is the same, then just throw it away. */

  IF SAMEAS DO $( FREEVEC(THISMATCH); RESULTIS FALSE $)
  $)CompareOldMatches

 /* This way of matching the GLI item is new, save it and increment
 count of number of instances found.
 */
 NMATCH+:=1;
 MATCHES!NMATCH:=THISMATCH;
 RESULTIS TRUE
 $)Addmtch

LET IMGFLOOR(P) = VALOF $(mgflr
 STATIC $( SL = NIL $);
 /* Use symmetry restrictions to derive some constraints on CONGEN nodes
 that might match GLI item node P.
 SYMLIM!P, if non zero, identifies another GLI node ("SL") that should
 have been mapped earlier. The node "P" matches should in general be
 "greater than" the node "SL" matched.
 (Have still to work out what FGLN etc do)
 */

 SL:=SYMLIM!P;
 UNLESS SL=0 DO SL:=CGPNUMBERING![MAPPEDTO!SL];
 RESULTIS (P=FGLN -> (SL>FGLNLIM -> SL,FGLNLIM),SL)
 $)mgflr





let SUBSETP(SMALL,LARGE) = valof $(
 /* When testing atom properties such as AROMATIC character or HYBRID
 character, which are represented bit-patterns in single words, may
 need to know if one set of choices is a true subset of another set
 of choices. This code is meant to determine that.
 */
  resultis (0 = (SMALL BITAND (NOT LARGE)))
$)


LET TRYMAP(G,PPTR,P) BE $(trymp
 /* Together with GMSTEP(), TRYMAP() forms a recursive Graph Matching
  scheme. GMSTEP looks after termination, symmetry considerations for
  the GLI-item node P and initial selection of candidate "G"s.
  TRYMAP() has to confirm firstly that atom properties of P and G,
  are appropriate, then that the potential for unmatched bonds is
  satisfactory and finally, by checking through neighbors of P and
  G matched at outer levels of recursion, that the known bonding
  is in agreement.
  If all OK, the assignment of P to G is made, and GMSTEP() called
  to deal with next GLI-node.

  G is the node index number from CGP (CONGEN PROBLEM PART)
  P is the node index number from GLI (GOOD LIST ITEM)
  PPTR is a pointer into the MATCHTABLE data record for this GLI item,
	its actually pointing to the first prior neighbor of P,
	data defining the degree, unmatched degree and unmatched bond-order
	is in the three proceeding locations of GLITABLE.

 */

  LET OLDNG = NIL;
  LET PDEG=GLITABLE!(PPTR-3)
  LET PUM=GLITABLE!(PPTR-2)
  LET PUMBO=GLITABLE!(PPTR-1)

 /* Although we are in middle of a bit of recursive code, quite a lot
 of variables can be statics. These are all variables whose values
 have been finished with before we recurse into a deeper level.
 */

static $(
PBO  = NIL;
FAILED = NIL; 
GBO  = NIL;
GDEG = NIL; 
GNBR = NIL;
GUM = NIL;
GUMBO = NIL; 
PTR = NIL; 
PTRTOP = NIL; 
ONBR = NIL;
PNBR = NIL 
$)


  /* Testing node "G" of molecular graph as a candidate for GLI node P, 
  (G shouldn't be mapped already).
  */
  UNLESS MAPPEDTO!G=0 DO RETURN;

  /* UMARKS, this facility not fully implemented, its supposed to
  provide an additional way of restricting possible matches.

  September '80, use UMARKS for COLOUR tags on atoms.

  */

  UNLESS SUBSETP(UMARKS!G,UMARKS!P) DO RETURN;

  /* First tests are obvious, is atom type for G one of those allowed
  for current pattern node (P, whence ATTYPEP etc).
  Similarly, check Hrange restriction,
    aromatic character,
    hybridtype
  */

  UNLESS TESTELEM(ATTYPE!G,ATTYPE!P) DO RETURN;
  IF HMIN!P>HMIN!G DO RETURN;
  IF HMAX!P<HMAX!G DO RETURN;
  unless SUBSETP(ARTYPE!G,ARTYPE!P) DO RETURN;
  unless SUBSETP(HYBRIDTYPE!G,HYBRIDTYPE!P) DO RETURN;

  /* OK, atom properties match, therefore must consider any
  known bonding constraints for G and P.
  */


  PTR:=CTSTART!G-1;
  PTRTOP:=CTSTOP!G;
  GDEG:=PTRTOP-PTR;

  /* If "G" has fewer bonds defined than P then can't match. */
  IF PDEG>GDEG DO RETURN;

  
  /* By definition, all atoms with the same type of bonding must
   be in the same orbit. So if just looking for existence of bond
   need only consider the orbit representatives. This is case
   where want exactly 0 instances of a substructure (MAXMATCH=1).
   Then, can skip nodes from CGP if they are not orbit reps. */

  IF MAXMATCH=1 DO $( 
	OLDNG:=ORBREP(G); 
	IF OLDNG<0 DO RETURN 
	$)


  GUM:=0;
  GUMBO:=0;
  ONBR:=0;
  FAILED:=FALSE;

  /* Now look at what is known about the bonding of node G as currently
  defined in the CGP. 
     Look at all its known neighbors,
       the bond order to neighboring CGP-nodes that have already
	been mapped onto nodes of the GLI-item should be recorded
	in BOSCRATCH (for we shall later be checking that these bond-orders
	correspond to those linking P to its neighbors)

     If G currently has a bond defined to another CGP node that has
	not been matched, then the counts of G's "unmatched degree" (GUM)
	and "unmatched bond order" (GUMBO) should be appropriately
	updated.

  */

  WHILE PTR<PTRTOP DO
   $(Gnbrs
   PTR+:=1;
   GNBR:=CTABLE!PTR;

   /* This code says:
       if G and GNBR are joined by an ANY bond 
		if GNB not been matched increase G's unmatched 
					degree and unmatched bond order
		if GNB is matched then record bond-order back to it as -1

	if G and GNBR are joined by a normal bond
		if GNB not been matched increase G's unmatched 
					degree (if appropriate)
					and unmatched bond order
		if GNB is matched then increment bond-order back to it by 1

     ONBR is just being used in normal way to allow detection of multiple
	bonds from appearance of successive identical entries in the CTABLE.

	
   */
   TEST GNBR<0 THEN $(ANY
    TEST MAPPEDTO![-GNBR]=0 THEN $( GUM+:=1; GUMBO+:=1 $)
    OR BOSCRATCH![-GNBR]:=-1
    $)ANY
   OR $(BND
    TEST MAPPEDTO!GNBR=0 THEN $( UNLESS GNBR=ONBR DO GUM+:=1; GUMBO+:=1 $)
    OR BOSCRATCH!GNBR+:=1;
    $)BND
   ONBR:=GNBR
   $)Gnbrs

  /* PUM defines the number of additional neighbors of P, defined in
  the current GLI-item, that will eventually have to be matched 
  to neighbors of G at some further level of recursion. If P has more
  such neighbors than G has as yet unmapped neighbors amongst the CGP nodes
  then obviously the mapping would eventually fail. As can detect this
  now, can avoid further recursion and quit.
  Similarly, can detect if not going to get appropriate bond-orders.
  */

  IF PUM>GUM DO $( FAILED:=TRUE; GOTO CLEANBOS $);
  IF PUMBO>GUMBO DO $( FAILED:=TRUE; GOTO CLEANBOS $);

  IF [PDEG-PUMBO]>[GDEG-GUMBO] DO $( FAILED:=TRUE; GOTO CLEANBOS $);

   /* Now, check the correspondence between the neighbors of P and
   neighbors of G that have already been matched. PPTR is pointing
   to start of P's MATCH-TABLE, entries are positive node numbers
   if P has a single bond back to a prior matched node, and -ve
   node numbers followed by a bond-order if P has ANY or multiple
   bond's back to a prior matched node. 
   Have to check that these prior matched neighbors of P correspond
   to the prior mapped neighbors of G and that the bond orders
   are compatible.

   Loop terminates when find 0 at end of P's list of prior mapped 
   neighbors.

   */

   $(PsNBRs
   PNBR:=GLITABLE!PPTR;
   PPTR+:=1;
   IF PNBR=0 DO BREAK;

   /* Decode bond-order information etc. */
   TEST PNBR>0 THEN PBO:=1
   OR $( PBO:=GLITABLE!PPTR; PPTR+:=1; PNBR:=-PNBR $);


   GNBR:=MAPPEDTO!PNBR;
   GBO:=BOSCRATCH!GNBR;

   /* What the next test says is:
	if PBO>0 then have a bond, of specific bond order, back from
		P to PNBR, this bond order must be exactly the same
		as that of the bond joining G to GNBR.

	if PBO<0 then have an ANY bond back from P to PNBR in which
		case any (non-zero!) bond order in the CGP graph is OK
   */

   UNLESS (PBO>0 -> PBO=GBO,GBO NE 0) DO $( 
		FAILED:=TRUE; 
		BREAK $)

   $)PsNBRs REPEAT;



CLEANBOS:

  /* Its assumed that BOSCRATCH is always zeroed out, so remove any
  data inserted defining bond-orders of bonds of atom G.
  */
  PTR:=CTSTART!G-1;
  WHILE PTR<PTRTOP DO $( PTR+:=1; BOSCRATCH![ABS[CTABLE!PTR]]:=0 $);



  IF FAILED DO
   $(fail
   IF MAXMATCH=1 DO UNORBREP(G,OLDNG);
   RETURN
   $)fail

  /* Do assignment of P to G, and recursively call GMSTEP. */

  MAPPEDTO!P:=G;
  MAPPEDTO!G:=P;
//  DEPTHRECUR+:=1; NEWLINE(1)
//  for III=2 to DEPTHRECUR do OUTS("|                 ");
//  OUTS("(GLI-node "); OUTNO(P); OUTS(", CGP-node "); OUTNOL(G)



  GMSTEP(PPTR);

  /* Deassign P and G. */
  MAPPEDTO!G:=0;
  MAPPEDTO!P:=0;
  IF MAXMATCH=1 DO UNORBREP(G,OLDNG);
  //  DEPTHRECUR-:=1

$)trymp



and GMSTEP(PPTR) BE $(gmstp
 /*   A more or less standard Graph-Matcher, GMSTEP is used when checking
 to see how many instances of some given substructure are included in
 the current CONGEN-PROBLEM-PART (CGP). Its use is
 1) for checking constraints in the form "XYZ NONE".
 2) for checking all constraints implying construction
	("ABC EXACTLY 2", "IJK AT LEAST 3", "RST FROM 2 TO 5" etc)
	to see if, in the current CGP, the minimum is already
	satisfied.
 3) for checking maxima after GLSTEP() has constructed some required
	feature in order to verify that this construction did not
	violate the maximum limit of some other feature.

 GMSTEP is recursive, its argument is a ptr into a MATCH-TABLE data
 structure.
 (In the original version of this program, clever use is made of static 
 and dynamic variables in an attempt to maximise efficiency and minimise use
 of BCPL-system stack. This code has been extensively modified for
 the obscurity of the clever code seemed to outweigh any time advantages.)


 */


 STATIC $( GMTSTRT = NIL $)

 LET P,PIMG =GLITABLE!PPTR, NIL;



 IF P=0 DO $(alldone 
       /* Termination of recursion, here find that next atom is zero, i.e.
         no more to be matched, so add current match to collection and return. */
	ADDMATCH(); 
//  	TIMINGS!TIMEGM+:=MSRUNTIME()-GMTSTRT
	RETURN $)alldone

 /* Increment PPTR over PUM, PUMBO, PDEG etc so that it points to
 the list of neighbors of P that should have been matched at outer levels
 of recursion.
 */
 PPTR+:=4;

 /* Find any symmetry restrictions on which nodes of G may match to P;
 this restriction derived from IMGFLOOR(P), and covers case where
 P is symmetrically related to some other node of this GLI-item which 
 will have been matched at outer levels of recursion.
 */
 PIMG:=IMGFLOOR(P)


 TEST GLITABLE!PPTR=0 THEN
  $(FirstOne
  /* P has a zero list of neighbors, i.e. P is the first node in one 
  of the connected components of current GLI-item. Can, nevertheless, 
  get some restrictions on candidate nodes in CGP that may match P from 
  symmetry. PIMG defines one less than the index number of the
  CGP node that is allowable as a match for P; so work up through
  nodes of CGP that are higher.
  */
  LET GIX = PIMG;

//    GMTSTRT:=MSRUNTIME()


  WHILE GIX<NCGPNDS DO $( 
		GIX+:=1; 
		TRYMAP(CGPNUMBINV!GIX,PPTR,P); 
		IF NMATCH=MAXMATCH DO RETURN $)
  $)FirstOne
 OR
  $(SubstituentOne
  /* Here dealing with a pattern node that is a substituent on some
  other pattern node already matched. This allows for more demanding
  restrictions on candidate nodes in graph that may match this node.
  Since P is bonded to PNBR, the candidate nodes for P must be
  those bonded to GNBR (= MAPPEDTO!PNBR); this restriction
  is in addition to the symmetry type restrictions provided by IMGFLOOR().
  */
  LET GPTR,GPTRTOP,GNBR,GCAND = NIL,NIL,NIL,NIL;
  LET ONBR=NIL
  LET PNBR,PIMF =ABS[GLITABLE!PPTR], PIMG; 
  GNBR:=MAPPEDTO!PNBR;
  GPTR:=CTSTART!GNBR-1;
  GPTRTOP:=CTSTOP!GNBR;
  ONBR:=0;
  WHILE GPTR<GPTRTOP DO
   $(GNBRsNBRS
   /* Here in this loop consider as candidates those 
   atoms from the CONGEN-PROBLEM-PART that are neighbors of GNBR.
   */
   GPTR+:=1;
   GCAND:=CTABLE!GPTR;
   IF GCAND=ONBR DO LOOP;
   GCAND:=ABS[GCAND];
   UNLESS CGPNUMBERING!GCAND>PIMF DO LOOP;
   TRYMAP(GCAND,PPTR,P);
   IF NMATCH=MAXMATCH DO RETURN;
   ONBR:=CTABLE!GPTR
   $)GNBRsNBRS
  $)SubstituentOne
 $)gmstp


LET SETUPPAT(PATREC) BE
 $(stppt
 CURRENTPATREC:=PATREC;
 IF PATREC=0 DO RETURN;
 GLITABLE:=PATREC!0;
 NCE:=PATREC!1;
 CEN1:=PATREC!2;
 CEN2:=PATREC!3;
 NCN:=PATREC!4;
 CN:=PATREC!5;
 MCHSIZ:=NCN+[NCE<<1]
 $)stppt


LET TESTPATMAXS() = VALOF $(tstptmxs
 STATIC $( SUCCEEDED = NIL; IMATCH = NIL; TESTNUM = NIL $);
 LET S1,S2,S3,S4,S5=CURRENTPATREC,MAXMATCH,NMATCH,MATCHES,FGLN;
 LET XTIME = 0;

 /* After any new substructure has been built into the current case
 must check again all those substructures which specified some
 maximum upper limit on their occurrences. (Because building desired
 fragment may have inadvertently lead to construction of too many
 of something else).
 */

//   XTIME:=MSRUNTIME()

 SUCCEEDED:=TRUE;
 FGLN:=0;
 TESTNUM:=0;

 WHILE TESTNUM<NUMPAT DO
  $(pats
  TESTNUM+:=1;
  MAXMATCH:=PATMAXS!TESTNUM+1;

  /* An upper limit of 100 is standard way of designating no real
  upper limit. So if MAXMATCH(=upper limit+1)>100 then no need
  to check limits for this particular pattern.
  */

  IF MAXMATCH>100 DO LOOP;

  /* Otherwise, setup pattern as current one, and do graph matching. */
  SETUPPAT(PATRECS!TESTNUM);
  MATCHES:=NEWVEC(MAXMATCH);
  NMATCH:=0;

  /* Do the graph matching to find how many instances we have of
  the substructure.
  */

  GMSTEP(0);

  IF MAXMATCH>1 DO
   $(releasespace
   IMATCH:=NMATCH;
   WHILE IMATCH>0 DO $( FREEVEC(MATCHES!IMATCH); IMATCH-:=1 $)
   $)releasespace
  FREEVEC(MATCHES);
  /* If NMATCH=MAXMATCH it means have one more than number of instances
  required, this structure is bad!
  */

  IF NMATCH=MAXMATCH DO $(badone SUCCEEDED:=FALSE; BREAK $)badone
  $)pats

 /* Reset various globals and return. */

 SETUPPAT(S1);
 MAXMATCH,NMATCH,MATCHES,FGLN:=S2,S3,S4,S5;


//   TIMINGS!TIMETPMX+:=MSRUNTIME()-XTIME

 RESULTIS SUCCEEDED
 $)tstptmxs

LET SCORECGP() be $(scores
 MANIFEST $( ROUNDING = CFMAX/2 $)
 STATIC $( SUCCEEDED = NIL; IMATCH = NIL; TESTNUM = NIL $);
 LET S1,S2,S3,S4,S5=CURRENTPATREC,MAXMATCH,NMATCH,MATCHES,FGLN;

 /* After a new substructure has been built into the current case
 must check again all those substructures which have scores associated
 with them. A new score has to be computed for the CASE based upon
 the combination of features that it contans.
 */

 FGLN:=0;
 TESTNUM:=0;
 NEWBELIEF:=0
 NEWDISBELIEF:=0

 WHILE TESTNUM<NUMPAT DO
  $(pats
  TESTNUM+:=1;
  /* Only need bother with substructures that have a non-zero associated
  SCORE.
  */
  if SUBSCORES!TESTNUM=0 then loop;

 /* Otherwise, setup pattern as current one, and do graph matching. 
    SCORES are assigned based on occurrence/non-occurrence of particular
    features so need only look for one instance of any of these substructures. 
  */
  MAXMATCH:=1;
  SETUPPAT(PATRECS!TESTNUM);
  MATCHES:=NEWVEC(MAXMATCH);
  NMATCH:=0;

  /* Do the graph matching to find how many instances we have of
  the substructure.
  */

  GMSTEP(0);

  IF MAXMATCH>1 DO
   $(releasespace
   IMATCH:=NMATCH;
   WHILE IMATCH>0 DO $( FREEVEC(MATCHES!IMATCH); IMATCH-:=1 $)
   $)releasespace
  FREEVEC(MATCHES);
  /* If NMATCH>0 it means have at least one instance of the current
  substructure in the current case.
  */
  if NMATCH>0 then $(assignscore

	test SUBSCORES!TESTNUM>0 then $(POS
		/* THIS PATTERN CONTRIBUTES POSITIVELY TO CONFIDENCE
		IN CORRECTNESS OF STRUCTURE, THEREFORE UPDATE BELIEF RATING.
		*/
		NEWBELIEF:=NEWBELIEF+(ROUNDING+SUBSCORES!TESTNUM*(CFMAX - NEWBELIEF))/CFMAX
		$)POS
	or $(NEG
		/* THIS PATTERN CONTRIBUTES NEGATIVELY TO CONFIDENCE
		IN CORRECTNESS OF STRUCTURE, THEREFORE UPDATE DISBELIEF RATING.
		*/
		NEWDISBELIEF:=NEWDISBELIEF+
			(ROUNDING+(ABS (SUBSCORES!TESTNUM))*(CFMAX - NEWDISBELIEF))/CFMAX
	   $)NEG
	
	$)assignscore

  $)pats

 /* Reset various globals and return. */

 SETUPPAT(S1);
 MAXMATCH,NMATCH,MATCHES,FGLN:=S2,S3,S4,S5;
 $)scores


LET REMANY(ND,NBR,BORD) BE $(rmny
 STATIC $( PTR = NIL; PTR2 = NIL; NBR2 = NIL $);
 /* The structure ("CASE"/"CONGENPROBLEMPART") had an ANY bond between
 ND and NBR; have now decided that the correct order for this bond
 be BORD. The CTABLE entries for both ND and NBR must both be adjusted
 this is achieved through two calls to REMANY; each call adjusting
 solely the CTABLE entry for its first argument ND.
 */

 NBR:=-NBR;

 /* If BORD > 1 then the CTSTOP value for ND must be adjusted upwards. */
 PTR:=CTSTOP!ND;
 PTR2:=PTR+BORD-1;
 CTSTOP!ND:=PTR2;

  $(loopBack
  /* Look at NBRS of ND, running down from last entry and adjusting
  data appropriately. For example suppose ND had as its CTABLE data
  "5,-6,9,-" and we now decided that the bond from ND to 6 be of
  order 2 then would
    i) find "9" and create (temporarily) the record 5,-6,9,9
   ii) find "-6", create the entries 5,-6,6,9 then 5,6,6,9 then RETURN

  */
  NBR2:=CTABLE!PTR;

  TEST NBR2=NBR THEN
	$(foundThisAnyBond
	NBR:=-NBR;
	WHILE PTR2 GE PTR DO 
			$(fixBord CTABLE!PTR2:=NBR; PTR2-:=1 $)fixBord
	RETURN
	$)foundThisAnyBond 
     OR CTABLE!PTR2:=CTABLE!PTR;

  PTR-:=1;
  PTR2-:=1
  $)loopBack REPEAT

 $)rmny

LET PUTANY(ND,NBR) = VALOF $(ptny
 STATIC $( PTR = NIL; PTRTOP = NIL; PTR2 = NIL; BO = NIL; NBR2 = NIL $);
 
 /* Have finished with some matching of a GLI-item to current CGP ("CASE");
 before this GLI-item was matched the CGP had an "ANY" bond between ND
 and NBR. This ANY bond should be put back before we look for
 further matchings of the current GLI-item etc. We also return, as the
 value of the function, the bond-order of the bond we chose to put
 between ND and NBR; sometimes this value is simply ignored, sometimes
 its needed to restore counts of the number of bonds to be built.
 */

 PTR:=CTSTART!ND-1;
 PTRTOP:=CTSTOP!ND;
 BO:=0;

 WHILE PTR<PTRTOP DO
  $(NBRSofND
  PTR+:=1;
  NBR2:=CTABLE!PTR;

  TEST NBR=NBR2 THEN $(Foundit
	/* There will be one, or more successive entries for NBR in
	the CTABLE for ND, the first such entry is to be adjusted
	to put back "ANY" bond (negate the atom number), any
        successive entries just add to count of number of bonds that
	were put between ND and NBR. PTR2 is left pointing at the
        entry for the ANY bond.
        */
   	TEST BO=0 THEN $(First BO:=1; CTABLE!PTR:=-NBR; PTR2:=PTR $)First
	   OR BO+:=1
        $)Foundit
  OR IF BO>0 DO $(Pastit 
		/* Entries in the CTABLE coming after the place where
		the ANY bond occurred may have to be pushed back if
		BO>1, this code just accomplishes appropriate adjustment.
		*/
		PTR2+:=1; 
		CTABLE!PTR2:=NBR2 $)Pastit

  $)NBRSofND

 /* Finally, update the CTSTOP value of ND. */

 CTSTOP!ND:=PTR2;
 RESULTIS BO

 $)ptny



LET POPVEC(SPTR0) = VALOF $(PPVC
 STATIC $( ANSVEC = NIL; NSTACK = NIL $);
  /* Computed data left on stack, allocate vector of sufficient size
  to hold this data and copy off stack, reset stack pointer.
  */
  NSTACK:=STACKPTR-SPTR0;
  IF NSTACK=0 DO RESULTIS 0;
  ANSVEC:=NEWVEC(NSTACK);
  ANSVEC!0:=NSTACK;
  BLT(STACK+SPTR0+1,ANSVEC+1,ANSVEC+NSTACK);
  STACKPTR:=SPTR0;
  RESULTIS ANSVEC
$)PPVC

 LET CANLOOP(COMP,COMPV,NDFREEV) = VALOF $(CNLP
  STATIC $( COMPSZ = NIL; ND = NIL; NDV = NIL; VEXT = NIL; ONBR = NIL;
               PTR = NIL; PTRTOP = NIL; NBR = NIL; LOOPFV = NIL $);

  /* Here we have to compute how many "loops" could be put on a particular
  component of the CONGEN-PROBLEM-PART. 

  example:

         \ /
          1
         / \
        6   2-
        |   |	(2-3 bond of order ANY)
        5   3-
         \ /
          4
          |


   Loops would correspond in this structure to the bonds (1-2), (1-3), (1-4)
   (2-3), (2-4) and (3-4). However, not all of these loops are allowed,
   we can't increase the order of (1-2) or (3-4), because (2-3) is marked
   as an ANY bond its bond order can be increased. So allowed loops
   would be (1-3), (1-4), (2-3) and (2-4).

   method:
	?


  */
  LOOPFV:=0;
  COMPSZ:=COMP!0;
  WHILE COMPSZ>0 DO
   $(NextAtom
   ND:=COMP!COMPSZ;
   COMPSZ-:=1;
   NDV:=NDFREEV!ND;
   VEXT:=COMPV-NDV;
   ONBR:=0;
   PTR:=CTSTART!ND-1;
   PTRTOP:=CTSTOP!ND;
   WHILE PTR<PTRTOP DO
    $(Nbrs
    PTR+:=1;
    NBR:=CTABLE!PTR;
    /* Can Ignore ANY bonds as they don't change potential for loops. */
    IF NBR<0 DO LOOP;
    IF NBR=ONBR DO LOOP;
    ONBR:=NBR;
    /* But if have a normal bond, then its order cannot be altered (as
    would happen if formed a loop), so reduce counts by valence of
    neighbor.
    */
    VEXT-:=NDFREEV!NBR
    $)Nbrs
   LOOPFV+:=(NDV>VEXT -> VEXT,NDV)
   $)NextAtom
  RESULTIS LOOPFV/2
$)CNLP

//  LET FREE1() BE $( FREEVEC(NDFREEV+CGPSTART); FREEVEC(HMAX2+CGPSTART) $);

 LET FREE2() BE $( FREECOMPS(COMPS); 
// FREE1() 
 $);

 LET FREE3() BE $( FREEVEC(REDHMAX); FREE2() $);

MANIFEST $( MINAROMATOMS = 5 $)
let VALIDATEATOMPROPERTIES(NEWTOTM) = valof $(validity
 static $( ARNBRS = NIL; BNDS = NIL; BO2 = NIL; BO3 = NIL; BOANY = NIL; 
	CHANGED = NIL; COUNT = NIL; LIM = NIL; NBR = NIL; NBRS = NIL; ND = NIL; 
	ZHYBRIDTYPE = NIL; ZARTYPE = NIL; MBARNBR = NIL; ARBNDCNT = NIL; NOTARBNDCNT = NIL; 
	AROMPOS = NIL; AROMCOUNT = NIL;
	TEMP = NIL; NDFV = NIL; ONBR = NIL; PTR = NIL; PTRTOP = NIL $)


// OUTS("*C*LVALIDATE ATOM PROPERTIES.*C*L")

AROMCOUNT:=0

ND:=CGPSTART-1
until ND=CGPSTOP do $(InitNds
	ND+:=1
	TEMPHYBS!ND:=HYBRIDTYPE!ND
	TEMPARS!ND:=ARTYPE!ND
	if (ARTYPE!ND BITAND AROMATIC) then AROMCOUNT+:=1
	$)InitNds

CHANGED:=TRUE

while CHANGED do $(chnglp
 CHANGED:=FALSE
 AROMPOS:= AROMCOUNT GE MINAROMATOMS ; 
 AROMCOUNT:=0;

// OUTS("START OUTER LOOP.*C*L")


 ND:=CGPSTART-1

 until ND=CGPSTOP do $(Nds


	ND+:=1
        ZHYBRIDTYPE:=TEMPHYBS!ND
        ZARTYPE:=TEMPARS!ND

// 	OUTS("FOR ATOM "); OUTNOS(ND); OUTS("ZHYB ZAR : "); OUTO(ZHYBRIDTYPE); OUTO(ZARTYPE); NEWLINE(1)

        PTR:=CTSTART!ND-1; PTRTOP:=CTSTOP!ND
        ONBR:=0; COUNT:=0; NBRS:=0; ARNBRS:=0; BOANY:=0; BO2:=0; 
	BO3:=0; MBARNBR:=FALSE; ARBNDCNT:=0; NOTARBNDCNT:=0; 
	/* Recompute Node free valence, generally could just use value
	in NDFREEV!ND but, in call following any updating of hranges
	it may be that true Node free valence is less than NDFREEV.
	*/
	NDFV:=TYPEVALENCE![ATTYPE!ND]-CTSTOP!ND+CTSTART!ND-1;
        NDFV-:=HMIN!ND
        until PTR=PTRTOP do $(nbrs
		PTR+:=1;
		NBR:=CTABLE!PTR;
		test NBR=ONBR then COUNT+:=1 or $(new
			switchon COUNT into $(sw
				case 3: BO3+:=1; endcase;
				case 2: BO2+:=1; 
					if (TEMPARS!(ABS ONBR) = AROMATIC) then MBARNBR:=TRUE;  
					endcase;
				default:
				$)sw
			COUNT:=1
			if (NDFV>0) & (NEWTOTM GR 0) & (NBR LS 0) then BOANY+:=1
			NBRS+:=1
			$)new
		if (TEMPARS!(ABS NBR) BITAND AROMATIC) NE 0 do ARNBRS+:=1
		if (TEMPARS!(ABS NBR) = AROMATIC) do ARBNDCNT+:=1
		if (TEMPARS!(ABS NBR) = NOTAROM) do NOTARBNDCNT+:=1
		ONBR:=NBR
		$)nbrs
	/* Complete entry regarding bond-order to last atom/atom group. */
	switchon COUNT into $(sw
		case 3: BO3+:=1; endcase;
		case 2: BO2+:=1; 
			if (TEMPARS!(ABS ONBR) = AROMATIC) then MBARNBR:=TRUE;  
			endcase;
		default:
		$)sw

//	OUTS("DERIVED FALUES: *C*L")
//	OUTS("NDFV "); OUTNOS(NDFV)
//	OUTS("BO3 "); OUTNOS(BO3); OUTS("BO2 "); OUTNOS(BO2)
//	OUTS("ARNBRS "); OUTNOS(ARNBRS)
//	if MBARNBR then OUTS("multibonded ARNBR")
//	NEWLINE(1)

	/* Now should have sufficient info to work out new allowed hybridization
	and aromatic tags.

        */

        test TYPEVALENCE!(ATTYPE!ND)>3 then LIM:=3 or LIM:=2

//	OUTS("LIMIT FOR AR CHECK "); OUTNOL(LIM)

   	unless ARTYPE!ND = NOTAROM do $(chkar
   	   /* Have to check allowed aromatic types for this ND. An aromatic
   	   Node must be one with potential for two aromatic neighbors
   	   (sum of free valences + known bonds to atoms possibly of aromatic
              character must equal at least two (three if atom valence>3 e.g. C)
              and its hybridtype must be sp3 or sp2 (sp3 because of things
   	   like the oxygen in a furan).
              */
//	   OUTS("CHECK ARTYPE ");

	   TEMP:=((ZHYBRIDTYPE BITAND SP2) | 
		  ((TYPEVALENCE!(ATTYPE!ND) LE 3) & (ZHYBRIDTYPE BITAND SP3)));
           unless (((ARNBRS+NDFV) GE LIM)  & TEMP)
   		  do TEMPARS!ND:=NOTAROM
   	   $)chkar

   /* Note that can't in general say an atom is aromatic, (that 
	requires much more complete analysis with graph matching 
	against aromatic templates).
	However, if an atom is multiply bonded to another "aromatic" atom, then
	it really ought to be restricted to being aromatics.
	Also, if an atom is known to be aromatic, that may force some of
	its nbrs to be aromatic.

  */
	if MBARNBR then TEMPARS!ND:=TEMPARS!ND BITAND AROMATIC

	if TEMPARS!ND=AROMATIC then $(nbrchk
		/* checks possible seem a bit limited. 
		if TYPEVALENCE - HMIN - NOTARBNDCNT is less than LIM can't
		make enough aromatic type bonds and this case no good,
		if equal to LIM then make all nbrs of type either into
		type aromatic, set CHANGED if necessary
		*/
		TEMP:=TYPEVALENCE![ATTYPE!ND]-HMIN!ND-NOTARBNDCNT
	        if TEMP LS LIM resultis FALSE
		if TEMP EQ LIM then $(forcenbrs
			PTR:=CTSTART!ND-1;PTRTOP:=CTSTOP!ND
			until PTR=PTRTOP do $(nbr
				PTR+:=1
				NBR:=ABS (CTABLE!PTR)
				if TEMPARS!NBR = NOTAROM then loop
				if TEMPARS!NBR = AROMATIC then loop
				CHANGED:=TRUE
				TEMPARS!NBR:=AROMATIC
				$)nbr
			$)forcenbrs

		$)nbrchk


	/* Now look to hybridization:
	  if BO3>0 then it must be "ALKYNE"
          if BO2>1 then it must be "ALLENE"
          if BO2=1 then it could be "ALLENE" | "SP2" or either.
		(either is possible if have an "ANY" bond + 1fv, or have 2fv
		(only SP2 possible otherwise
	  if BO2=0 then
		("ALLENE" is possible if have 4fvs, 1 any + 3fvs, 2 any + 2 fvs
		("ALKYNE" is possible if have 3 fvs, 1 any + 2fvs
		("SP2" is possible if have 2 fvs, 1 any + 1fvs
		("SP3" is possible.
	*/
        test BO3 GR 0 then TEMPHYBS!ND:=ALKYNE
        or 
        test BO2 GR 1 then TEMPHYBS!ND:=ALLENE
        or
        test BO2 = 1 then $(
		test ((NDFV+BOANY) GE 2) then TEMPHYBS!ND:=DBTYPE
		or TEMPHYBS!ND:=SP2
		$)
	or $(	TEMPHYBS!ND:=SP3
		COUNT:=NDFV+BOANY
		if COUNT GE 4 then TEMPHYBS!ND:=TEMPHYBS!ND BITOR ALLENE
		if COUNT GE 3 then TEMPHYBS!ND:=TEMPHYBS!ND BITOR ALKYNE
		if COUNT GE 2 then TEMPHYBS!ND:=TEMPHYBS!ND BITOR SP2
	   $)

	if TEMPARS!ND=AROMATIC then $(aromhybs
		test TYPEVALENCE!(ATTYPE!ND) >3 then TEMPHYBS!ND:=TEMPHYBS!ND BITAND SP2
		or TEMPHYBS!ND:=TEMPHYBS!ND BITAND (SP2 BITOR SP3)
		$)aromhybs

	TEMPHYBS!ND:=TEMPHYBS!ND BITAND HYBRIDTYPE!ND
	unless TEMPHYBS!ND = ZHYBRIDTYPE do CHANGED:=TRUE
	TEMPARS!ND:=TEMPARS!ND BITAND ARTYPE!ND
        unless AROMPOS do TEMPARS!ND:=TEMPARS!ND BITAND NOTAROM
	if TEMPARS!ND BITAND AROMATIC do AROMCOUNT+:=1
	unless TEMPARS!ND = ZARTYPE do CHANGED:=TRUE
	if TEMPHYBS!ND=0 then resultis FALSE
	if TEMPARS!ND=0 then resultis FALSE
	$)Nds
$)chnglp

 resultis TRUE
$)validity




let SAVEHYBRIDS() = valof $(svhyb
 static $( ND = NIL; SPTR0 = NIL $)
 /* Go through the new sets of possible hybridizations for each
node in the CGP comparing them with existing values; if find
that they differ, save existing value on stack and change
value to that computed in TEMPHYBS, return as value of the
function a data structure defining the old values so that
 these may be restored.
 */
SPTR0:=STACKPTR
ND:=CGPSTART-1
while ND<CGPSTOP do $(Nds
  ND+:=1
  if TEMPHYBS!ND=HYBRIDTYPE!ND then loop
  STACKPTR+:=2
  STACK!(STACKPTR-1):=ND
  STACK!STACKPTR:=HYBRIDTYPE!ND
  HYBRIDTYPE!ND:=TEMPHYBS!ND
  $)Nds
resultis POPVEC(SPTR0)
$)svhyb

 

let RESTOREHYBRIDS(HYBS) be $(rsthyb
 static $( ND = NIL; P = NIL $)
 if HYBS=0 then return
 P:=HYBS!0
 while P>0 do $(
  ND:=HYBS!(P-1)
  HYBRIDTYPE!ND:=HYBS!P
  P-:=2
  $)
 FREEVEC(HYBS)
 $)rsthyb

  

let SAVEAROMS() = valof  $(svarms
 static $( SPTR0 = NIL; ND = NIL $)
 SPTR0:=STACKPTR
 ND:=CGPSTART-1
 while ND<CGPSTOP do $(
  ND+:=1
  if TEMPARS!ND=ARTYPE!ND then loop
  STACKPTR+:=2
  STACK!(STACKPTR-1):=ND
  STACK!STACKPTR:=ARTYPE!ND
  ARTYPE!ND:=TEMPARS!ND
 $)
resultis POPVEC(SPTR0)
$)svarms

 

let RESTOREAROMS(ARMS) be $(
 static $( ND = NIL; P = NIL $)
 if ARMS=0 then return
 P:=ARMS!0
 while P>0 do $(
  ND:=ARMS!(P-1)
  ARTYPE!ND:=ARMS!P
  P-:=2
  $)
 FREEVEC(ARMS)
$)

let CHANGEHRANGES() = valof $(CHRS
 /* 	Have to adjust the H-ranges associated with various nodes in the
 CGP to reflect implications of current matching of the GLI-item. Must
 also be able to restore current H-ranges when have finished with
 this matching of the GLI-item. So create a data structure, associated
 with a dynamic variable, that contains data defining current state.
 This data structure will be around when ultimately return back 
 to this level in the recursive scheme and need to do the restoration.

 	Actual process is to loop through all components, for each component
 loop through all atoms, put current H-range info in "STACK" and new
 limits into HMIN/HMAX.
	When all atoms processed, create a data-struck with appropriate
 info being copied out of "STACK". This data structure is returned
 as the value of the function and can be assigned to a dynamic variable
 in the calling environment.



 	Additions by NABG:

	quite frequently get a situation where only one atom in a component
 bears free-valences (e.g. have constructed (CH3)2-CH-) then it is
 true that the maximum number of Hs on that last remaining atom be
 less than its total freevalence.

	so added a bit of clumsy code to catch these cases.

 */
 static $( BASHMIN2 = NIL; COMP = NIL; COMPIX = NIL; COMPSZ = NIL; 
	   HMX = NIL; HMN = NIL; HMX2 = NIL; HMN2 = NIL; ND = NIL; 
	   FVNODE = NIL; FVCOUNT = NIL;
           SAVEDHS = NIL; SPTR0 = NIL 
	$)

 let CHANGESTACK() be
    $(ChangeHandStackOld 
    STACKPTR+:=3;
    STACK![STACKPTR-2]:=ND;
    STACK![STACKPTR-1]:=HMN;
    STACK!STACKPTR:=HMX;
    HMIN!ND:=HMN2;
    HMAX!ND:=HMX2;
    TOTHMIN+:=HMN2-HMN;
    TOTHMAX-:=HMX-HMX2
    $)ChangeHandStackOld

 SPTR0:=STACKPTR;
 COMPIX:=0;
 WHILE COMPIX<NCOMP DO
  $(EachComponent
  COMPIX+:=1;
  COMP:=COMPS!COMPIX;
  FVNODE:=0;
  FVCOUNT:=0;
  COMPSZ:=COMP!0;

  /* Keep a count of total number of atoms with free valences.
  also record the node (or last one if more than one) which has
  free valences and whose current HMAX=(HMIN+NDFREEV).
  If there is only one node with free valences in the component, and
  if current HMAX allows it to be saturated with Hs then (unless only
  one component) must reduce that HMAX!
  (if HMAX is less, then nothing need be done and FVNODE remains zero)

  */

  for I=1 to COMPSZ do  $(fvnds
	ND:=COMP!I
	if (NDFREEV!ND GR 0) then $( FVCOUNT+:=1
		if (HMAX!ND GE (HMIN!ND+NDFREEV!ND)) then FVNODE:=ND $)
	$)fvnds
  BASHMIN2:=HCOUNT-TOTCOMPHMAX-REDHMAX!COMPIX;
  WHILE COMPSZ>0 DO
   $(EachNode
   ND:=COMP!COMPSZ;
   COMPSZ-:=1;
   HMX:=HMAX!ND;
   HMN:=HMIN!ND;
   HMX2:=HMAX2!ND;
   HMN2:=BASHMIN2+HMX2;
   IF HMN2<HMN DO HMN2:=HMN;
   test [HMN2>HMN] BITOR [HMX2<HMX] then CHANGESTACK()
   or 
   if ((FVCOUNT=1) & (ND=FVNODE) & (NCOMP > 1)) then $(
	HMX2:=HMIN!ND+NDFREEV!ND-1
	CHANGESTACK()
	$)
   $)EachNode
  $)EachComponent
 FREE3()
 SAVEDHS:=POPVEC(SPTR0);
 resultis SAVEDHS
 $)CHRS

let STRIPANYS(NEWTOTM) = valof $(strpnys
 /* Current matching of some GLI-item to a CGP has exhausted the
 potential for multiple bonds. Consequently, bonds in that CGP
 still marked as "ANY" can now be assigned specific bond order of 1.
 Yet will have to restore "ANY" bonds in the CGP when have finished
 with the current GLI->CGP matching. 
 So create a data-structure, that will be returned as the result of
 this function and which will get assigned to some appropriate
 dynamic variable. This data-structure will contain info describing
 "ANY" bonds being removed by this function and so permit their later
 restoration by RESTOREANYS()



   MODS by NABG. More frequently than above, we get cases where potential
 for bonds on one atom has been exhausted by bond-building or H-range
 specification. In such cases, all "ANY" bonds referencing that atom
 should be fixed at bond order 1.

 */

 static $( ND = NIL; NBR = NIL; PTR = NIL; PTRTOP = NIL; SAVEDANYS = NIL; SPTR0 = NIL $)

 SPTR0:=STACKPTR;
 test NEWTOTM=0 then
  $(FixAllAnys
  ND:=CGPSTART-1;
  WHILE ND<CGPSTOP DO
   $(EachNode
   ND+:=1;
   PTR:=CTSTART!ND-1;
   PTRTOP:=CTSTOP!ND;
   WHILE PTR<PTRTOP DO
    $(Nbrs
    PTR+:=1;
    NBR:=CTABLE!PTR
    IF NBR>0 DO LOOP;

    /* Have found an ANY bond, as evidenced by the -ve neighbor, put
    it in stack, and modify CTABLE to designate bond-order of 1.

    */
    STACKPTR+:=1;
    STACK!STACKPTR:=PTR;
    NBR:=-NBR
    CTABLE!PTR:=NBR
    $)Nbrs
   $)EachNode
  $)FixAllAnys
 or $(trybyatoms
  ND:=CGPSTART-1;
  WHILE ND<CGPSTOP DO
   $(EachNode
   ND+:=1;
   if NDFREEV!ND GR 0 then loop;

   /* Looking at a node whose bonding capacity is saturated. */

   PTR:=CTSTART!ND-1;
   PTRTOP:=CTSTOP!ND;
   WHILE PTR<PTRTOP DO
    $(Nbrs
     static $( NBRPTR = NIL; NBPTRTOP = NIL $)
    PTR+:=1;
    NBR:=CTABLE!PTR
    IF NBR>0 DO LOOP;

    /* Have found an ANY bond, as evidenced by the -ve neighbor, put
    it in stack, and modify CTABLE to designate bond-order of 1.
    This stacking and changing has to be done for both atoms!
    (Code for case where all ANY bonds were being removed is simpler
    for then will recognise the change needed at both atoms involved,
    here may only realise the need for a change at one atom, but both
    must be altered.

    */
    STACKPTR+:=1;
    STACK!STACKPTR:=PTR;
    NBR:=-NBR
    CTABLE!PTR:=NBR
    NBRPTR:=CTSTART!NBR-1; NBPTRTOP:=CTSTOP!NBR;
    while NBRPTR<NBPTRTOP do $(NBRsnbrs
      NBRPTR+:=1;
      unless (ABS (CTABLE!NBRPTR))=ND do loop;
      /* have pointer to other location that must be changed. */
      STACKPTR+:=1;
      STACK!STACKPTR:=NBRPTR
      CTABLE!NBRPTR:=-(CTABLE!NBRPTR)
      $)NBRsnbrs
     $)Nbrs
    $)EachNode
 $)trybyatoms

 /* Allocate appropriate data-structure and copy data from stack. */
 SAVEDANYS:=POPVEC(SPTR0);
 resultis SAVEDANYS
 $)strpnys


let SAVEMAPPING() = valof $(SVMP

/* 	Some mapping of a GLI item to CGP has been found to be 
satisfactory with respect to H-range constraints, loops etc. About
to proceed either with testing maximum constraints on each
Good List Item used so far in formulating the problem (call to TESTPATMAXS and
thence to GMSTEP), or to continue by injecting next copy of current GLI-item 
if several have to be built (call to GLSTEP).

	The functions such as GMSTEP and GLSTEP are going to use
the vector "MAPPEDTO". Since we must keep a track of current mapping
(so that we can deassign the GLI-CGP nodes and restore the
CTABLE etc) its necessary to preserve a copy of the current mapping
across the calls to GMSTEP/GLSTEP etc.

	The current mapping is copied into the "STACK", a data-structure
is created to hold this info, this data structure is returned as the
value of SAVEMAPPING() and will be assigned to an appropriate
dynamic variable in the calling function.
	
*/
 static $( ND = NIL; NDIMG = NIL; SAVEDMAP = NIL; SPTR0 = NIL $)

 SPTR0:=STACKPTR
 ND:=CGPSTART-1;
 WHILE ND<CGPSTOP DO
  $(CGPNDS
  ND+:=1;
  IF MAPPEDTO!ND=0 DO LOOP;
  NDIMG:=MAPPEDTO!ND;
  STACKPTR+:=2;
  STACK![STACKPTR-1]:=ND;
  STACK!STACKPTR:=NDIMG;
  MAPPEDTO!ND:=0;
  MAPPEDTO!NDIMG:=0
  $)CGPNDS

 SAVEDMAP:=POPVEC(SPTR0);
 resultis SAVEDMAP

$)SVMP


let RESTOREMAP(SAVEDMAP) be $(RSTMP
 static $( PTR = NIL; ND = NIL; NDIMG = NIL $)
 /* 	RESTOREMAP is called from PROCGLIMATCH() when unwinding recursion
 after having finished with the processing of some GLI->CGP matching.
 RESTOREMAP has to restore the MAPPEDTO vector to its condition before
 PROCGLIMATCH was called; the appropriate data is given in the argument
 vector SAVEDMAP.
 */

 UNLESS SAVEDMAP=0 DO
  $(Restore
  PTR:=SAVEDMAP!0;
  WHILE PTR>0 DO
   $(Map1
   NDIMG:=SAVEDMAP!PTR;
   ND:=SAVEDMAP![PTR-1];
   PTR-:=2;
   MAPPEDTO!ND:=NDIMG;
   MAPPEDTO!NDIMG:=ND
   $)Map1
  FREEVEC(SAVEDMAP)
  $)Restore
$)RSTMP


let RESTOREANYS(SAVEDANYS) be $(RSTNYS
 static $( PTR = NIL; PTR2 = NIL $)
/* 	RESTOREANYS is called from PROCGLIMATCH when unwinding recursion
after finishing with some GLI->CGP mapping. This mapping may have been
one which lead to elimination of "ANY" bonds from the CTABLE for the
CGP; if so, these ANY bonds should now be restored. The relevant
data is provided by the argument SAVEDANYS.
*/

 UNLESS SAVEDANYS=0 DO
  $(PutBack
  PTR:=SAVEDANYS!0;
  WHILE PTR>0 DO
   $(Any1
   PTR2:=SAVEDANYS!PTR;
   PTR-:=1;
   CTABLE!PTR2:=-[CTABLE!PTR2]
   $)Any1
  FREEVEC(SAVEDANYS)
  $)PutBack

$)RSTNYS


let RESTOREHRANGES(SAVEDHS) be $(RSTHRNGS
 static $( PTR = NIL; ND = NIL; HMN = NIL; HMX = NIL; HMN2 = NIL; HMX2 = NIL $)
/* 	RESTOREHRANGES is called from PROCGLIMATCH() when its unwinding
recursion after finishing the processing of some GLI->CGP matching.
The matching may have resulted in some changes to the H-ranges allowed
for certain nodes in the CGP part. These H-ranges must now be restored
to such values as the had before the GLI<=>CGP matching was made.
The relevant data defining the previous H-ranges is given in the
argument vector SAVEDHS.

*/

 UNLESS SAVEDHS=0 DO
  $(PutBack
  PTR:=SAVEDHS!0;
  WHILE PTR>0 DO
   $(Hrange1
   ND:=SAVEDHS![PTR-2];
   HMN:=SAVEDHS![PTR-1];
   HMX:=SAVEDHS!PTR;
   PTR-:=3;
   HMN2:=HMIN!ND;
   HMX2:=HMAX!ND;
   HMIN!ND:=HMN;
   HMAX!ND:=HMX;
   TOTHMIN-:=HMN2-HMN;
   TOTHMAX+:=HMX-HMX2
   $)Hrange1
  FREEVEC(SAVEDHS)
  $)PutBack

$)RSTHRNGS



let  DEASSIGN(P,G,CTSTOPG,UMARKSG,HMING,HMAXG,ARTYPEG,HYBRIDTYPEG,OLDNG,TOTALNEWBONDS,TOTALMODABONDS) be $(DE
 /* Have finished with provision mapping of GLI-node "P" and CGP-node "G".
 When made that mapping, data in the CTABLE of the CGP part 
 was changed. Now must restore the data defining the CGP part to
 its state before tried mapping P<=>G.
 */

static $(
CTSG = NIL;
GNBR = NIL;
ONBR = NIL;
$)

//   DEPTHRECUR-:=1; 


  MAPPEDTO!G:=0;
  MAPPEDTO!P:=0;
  CTSG:=CTSTOP!G;   
  /* CTSG is value of CTSTOP for "G" subsequent to any new bonds being
  formed as result of G being made equivalent to P. 
  TOTALNEWBONDS worth of new bonds were made for that mapping
  */

  TOTB+:=TOTALNEWBONDS;	/* Restore Total Bond Order Count. */

  /* Now find if any multiple bonds were formed, if they were then
  TOTM (total multiple bonds) would have been reduced and needs
  to be corrected.
  */

 
  ONBR:=0;
  WHILE TOTALNEWBONDS>0 DO
   $(FindMultiBnd
   GNBR:=ABS[CTABLE!CTSG];
   CTSG-:=1;
   CTSTOP!GNBR-:=1;
   CTSTOP!G-:=1;
   IF ONBR=GNBR DO TOTM+:=1;	/* Adjust TOTM for this multi-bond. */
   ONBR:=GNBR
   TOTALNEWBONDS-:=1
   $)FindMultiBnd


  /* Some data relating to ANY bonds is on the stack, haven't quite 
  worked this bit out.
  */

   $(
   GNBR:=STACK!STACKPTR;
   STACKPTR-:=1;
   IF GNBR=0 DO BREAK;
   TOTB+:=PUTANY(G,GNBR)-1;
   TOTM+:=PUTANY(GNBR,G)-1
   $) REPEAT;

  UNORBREP(G,OLDNG);
  HYBRIDTYPE!G:=HYBRIDTYPEG;
  ARTYPE!G:=ARTYPEG;
  UMARKS!G:=UMARKSG;
  TOTHMIN-:=[HMIN!G-HMING];
  HMIN!G:=HMING;
  TOTHMAX+:=[HMAXG-HMAX!G];
  HMAX!G:=HMAXG

$)DE


let CONSTRUCTASSIGN(P,G,NEWHMIN,NEWHMAX,NEWAR,NEWHYB,NEWUMARKS,TOTALNEWBONDS,TOTALMODABONDS) be $(AS
 /*  Assign GLI-node "P" to CGP-node "G". This is in constructive mode.
  The atom properties of "G" need to be updated, for the assignment may
  for example imply a more specific H-range.
  Bonds may also have to be formed.
  Any such bonds are defined via the global variables:
    MODABPTR/MODABONDS     this data concerns bonds of the CGP that, before
				the matching of P<=>G, were ANY bonds but
				which now have some specific bond-order.

    NEWBPTR/NEWBONDS       this data defines new bonds that have no
				equivalent in the original CGP.


	As well as updating atom properties for "G" and changing its
  CTABLE entry, it is also necessary to update a few global variables
  such as the counts of bonds that remain to be formed.

 */

static $(
CTSG = NIL;
GBO = NIL;
GNBR = NIL
$)

//   DEPTHRECUR+:=1; NEWLINE(1)
//   for III=2 to DEPTHRECUR do OUTS("|                 ");
//   OUTS("(GLI-node "); OUTNO(P); OUTS(", CGP-node "); OUTNOL(G)
  CTSG:=CTSTOP!G;

  /* First update the global counts for Hydrogens, bonds, multiple bonds. */
  TOTHMIN:=NTOTHMIN;
  TOTHMAX:=NTOTHMAX;
  TOTB:=NTOTB;
  TOTM:=NTOTM;

  /* Adjust atom properties of node "G". */
  HMIN!G:=NEWHMIN;
  HMAX!G:=NEWHMAX;
  ARTYPE!G:=NEWAR;
  HYBRIDTYPE!G:=NEWHYB;
  UMARKS!G:=NEWUMARKS;

  /* Some of data on ANY bonds gets put on stack, we will need this
  data to restore the CGP when its time to DEASSIGN(P,G). The
  vectors MODABPTR etc are possibly going to get overwritten at
  successive levels of recursion so can not rely on the data being there.
  */

  STACKPTR+:=1;
  STACK!STACKPTR:=0;
  WHILE MODABPTR>0 DO
   $(anys
   GBO:=MODABONDS!MODABPTR;
   GNBR:=MODABONDS![MODABPTR-1];
   MODABPTR-:=2;
   STACKPTR+:=1;
   STACK!STACKPTR:=GNBR;
   REMANY(GNBR,G,GBO);
   REMANY(G,GNBR,GBO)
   $)anys


  /* CTSTOP!G will have been pushed up if had any ANY-bonds being converted
 into bonds of order>1. Update CTSG by number TOTALMODABONDS this
 supposedly being number of additional entries that will have been made.
 */
  CTSG+:=TOTALMODABONDS
  /* Put in new bonds. */
  WHILE NEWBPTR>0 DO
   $(NewBonds
   GBO:=NEWBONDS!NEWBPTR;
   GNBR:=NEWBONDS![NEWBPTR-1];
   NEWBPTR-:=2;

   TEST GBO<0 THEN
    $(NewAny
    /* The new bond being inserted is going to be an ANY bond. */
    CTSG+:=1;
    CTABLE!CTSG:=-GNBR;
    CTSTOP!GNBR+:=1;
    CTABLE![CTSTOP!GNBR]:=-G
    $)NewAny
   OR
    WHILE GBO>0 DO
     $(Bond1
     /* Loop around entering one extra bond at a time until have got the
     right bond-order.
     */
     GBO-:=1;
     CTSG+:=1;
     CTABLE!CTSG:=GNBR;
     CTSTOP!GNBR+:=1;
     CTABLE![CTSTOP!GNBR]:=G
     $)Bond1
   $)NewBonds
  CTSTOP!G:=CTSG;

//  OUTS("ASSIGNING "); OUTNOS(P); OUTS("TO "); OUTNOL(G);
  MAPPEDTO!P:=G;
  MAPPEDTO!G:=P;
$)AS


let RESTOREONEATPROPS(V) be $(rstaps
  static $( NUMAT = NIL; TYPE = NIL; ATNO = NIL; VAL = NIL; P = NIL $)

  if V=0 then return; /* no one atom changes, so nothing to undo. */

  NUMAT:=V!0

  TYPE:=V!1

  P:=2

  for N=1 to NUMAT do $(nl
    ATNO:=V!P
    P+:=1
    VAL:=V!P
    P+:=1
    switchon TYPE into $(sw
       case 1: /* HMIN of atom got changed, restore it. */
		HMIN!ATNO:=VAL
		endcase;
       case 2: /* HMAX of atom got changed, restore it. */
		HMAX!ATNO:=VAL
		endcase;
       case 3: /* artype of atom got changed. */
		ARTYPE!ATNO:=VAL
		endcase;
       case 4: /* Color, (UMARKS) of atom got changed. */
		UMARKS!ATNO:=VAL
		endcase;
       case 5: /* hybridization of atom got changed. */
		HYBRIDTYPE!ATNO:=VAL
		endcase;
	default:
		OUTS("PROBLEMS PROBLEMS, atom prop type got screwed up.*C*L")
		OUTS("Noticed when restoring props for atom ")
		OUTNOL(ATNO)
		OUTS("Type given as "); OUTNOL(TYPE)
		OUTS("Value given as "); OUTNOL(VAL)
		finish
	$)sw
  $)nl

  FREEVEC(V)
$)rstaps



let ONEATOMCONSTRAINTTYPE() = valof $(ct
 /* can only process simplest of kind of one atom constraints,
those where just one property being specified .
*/
static $( P = NIL; MINH = NIL; MAXH = NIL; HYB = NIL; ART = NIL;
  ATTYPEP = NIL; COL = NIL; VLNC = NIL; VLNCM1 = NIL $)

 let NUMBITS(I) = ((I=0) -> 0 , ((I BITAND 1) + NUMBITS(I>>1)))

P:=GLITABLE!0; /* node number of one atom constraint. */


ATTYPEP:=ATTYPE!P
unless NUMBITS(ATTYPEP) do resultis 0; /* it was some kind of polyatom. */


MAXH:=HMAX!P
MINH:=HMIN!P
HYB:=HYBRIDTYPE!P
COL:=UMARKS!P
ART:=ARTYPE!P

/* ATTYPEP currently a set, only one bit should be set so convert it back. */

for N=1 to NTYPES do 
	if TESTELEM(N,ATTYPEP) do $( ATTYPEP:=N; break $)

VLNC:=TYPEVALENCE!ATTYPEP
VLNCM1:=VLNC-1


/* check first if HMAX is zero, and all other properties are effectively
"any", then know should raise HMIN on other similar atoms.
*/

if ((MAXH=0) & (HYB=#17) & (COL=#7777) & (ART=#3)) then resultis 1

/* check first if HMIN is VLNCM1, and all other properties are effectively
"any", then know should reduce HMAX on other similar atoms.
*/

if ((MINH=VLNCM1) & (HYB=#17) & (COL=#7777) & (ART=#3)) then resultis 2

/* otherwise, unless H-range from 0 to VLNCM1 can't handle it. */

unless ((MINH=0) & (MAXH=VLNCM1)) do resultis 0

/* OK, no H-range given. */


if ((COL=#7777) & (HYB=#17)) then resultis 3; /* must be aromatics. */

unless ART=#3 do resultis 0

if (HYB=#17) do resultis 4; /* must be colors. */

unless COL=#7777 do resultis 0

resultis 5

$)ct



let SAVEONEATPROPS() = valof $(svonaps
 /* It became obvious that many typical GENOA problems involved
simple one atom constraints that the algorithm was handling
poorly. This code takes a few of these special cases and
provides additional analysis.
Consider for example a constraint of the form "CH3 exactly 6"

as well as implying the construction of exactly 6 methyls
this says, implicitly, that the upper limit of Hs on other
carbons can be reduced to at most 2. 

it is this implicit additional constraint that standard
algorithm is missing

in some cases, it is important to make the implicit statement
as well

of course, all such constraints could be given, thus the
user could define the number of ch3s ch2s chs and cs

however, it is usefull to check a few of these special
cases.

*/

static $( P = NIL; GIX = NIL; G = NIL; ARTG = NIL;
  MINH = NIL; MAXH = NIL; HYB = NIL; ART = NIL;
  ATTYPEP = NIL; COL = NIL; VLNC = NIL; VLNCM1 = NIL;
  OKCOUNT = NIL; COUNT = NIL; TEMP = vec 128; VAL = NIL; TYPE = NIL $)


unless MODE=2 do resultis 0; /* checks only apply in simple constraint mode. */

unless PATMINS!1 GR 0 do resultis 0; /* and only when some examples built. */

unless PATMAXS!1 LS 100 do resultis 0; /* and not when max is "ANY". */

unless PATMINS!1 = PATMAXS!1 do resultis 0; /* in fact, only in case where constraint is "exactly". */

unless MCHSIZ=1 do resultis 0; /* and then just to one atom constraints. */

TYPE:=ONEATOMCONSTRAINTTYPE()

if TYPE=0 then resultis 0; /* and only those involving just a single property. */


P:=GLITABLE!0; /* node number of one atom constraint. */
ATTYPEP:=ATTYPE!P
MAXH:=HMAX!P
MINH:=HMIN!P
HYB:=HYBRIDTYPE!P
COL:=UMARKS!P
ART:=ARTYPE!P

for N=1 to NTYPES do 
	if TESTELEM(N,ATTYPEP) do $( ATTYPEP:=N; break $)

VLNC:=TYPEVALENCE!ATTYPEP;
VLNCM1:=VLNC-1

GIX:=0
OKCOUNT:=0
COUNT:=0


while GIX LS NCGPNDS do $(
	GIX+:=1
	G:=CGPNUMBINV!GIX
	unless ATTYPE!G=ATTYPEP do loop
	switchon TYPE into $(sw
	   case 1: /* change HMIN if currently 0. */
		test ((HMIN!G=0) & (HMAX!G GR 0)) then
			$( COUNT+:=1; TEMP!COUNT:=G $)
		or if HMAX!G=0 then OKCOUNT+:=1
		endcase;
	   case 2: /* change HMAX if currently VLNCM1. */
		test (HMAX!G=VLNCM1) & (HMIN!G LS VLNCM1) then
			$( COUNT+:=1; TEMP!COUNT:=G $)
		or if HMIN!G=VLNCM1 then OKCOUNT+:=1
		endcase;
	   case 3: /* change ARTYPE if "any" */
	        test ARTYPE!G=#3 then $( COUNT+:=1; TEMP!COUNT:=G $)
		or if ARTYPE!G=ART then OKCOUNT+:=1
	        endcase;
	   case 4: /* umarks. */
		test UMARKS!G=COL then OKCOUNT+:=1 or $( COUNT+:=1; TEMP!COUNT:=G $)
	        endcase;
	   case 5: /* hybrid. */
		test HYBRIDTYPE!G=HYB then OKCOUNT+:=1 or $( COUNT+:=1; TEMP!COUNT:=G $)
	        endcase;
	   $)sw
        $)


unless OKCOUNT=PATMINS!1 do resultis 0


VAL:=NEWVEC(1+COUNT+COUNT)
VAL!0:=COUNT
VAL!1:=TYPE

P:=1
for N=1 to COUNT do $(nl
	G:=TEMP!N
	P+:=1
	VAL!P:=G
	P+:=1
	switchon TYPE into $(sw
		case 1: VAL!P:=HMIN!G; HMIN!G:=((HMIN!G = 0) -> 1, HMIN!G);
			endcase;
		case 2: VAL!P:=HMAX!G; HMAX!G:=((HMAX!G = VLNCM1) -> VLNCM1-1, HMAX!G); 
			endcase;
		case 3: VAL!P:=ARTYPE!G; ARTYPE!G:=(ARTYPE!G BITAND (NOT ART));
			endcase;
		case 4: VAL!P:=UMARKS!G; UMARKS!G:=(UMARKS!G BITAND (NOT COL));
			endcase
		case 5: VAL!P:=HYBRIDTYPE!G; 
			HYBRIDTYPE!G:=(HYBRIDTYPE!G BITAND (NOT HYB))
			endcase
		$)sw
	$)nl


resultis VAL
$)svonaps



let CONSTRUCTMATCH(G,P,PPTR) be $(

let PDEG,PUM,PUMBO = GLITABLE!(PPTR-3),GLITABLE!(PPTR-2),GLITABLE!(PPTR-1);
let ATTYPEP,UMARKSP,HMINP,HMAXP,ARTYPEP,HYBRIDTYPEP = 
	ATTYPE!P,UMARKS!P,HMIN!P,HMAX!P,ARTYPE!P,HYBRIDTYPE!P;
LET ATTYPEG,UMARKSG,HMING,HMAXG,ARTYPEG,HYBRIDTYPEG = 
	ATTYPE!G,UMARKS!G,HMIN!G,HMAX!G,ARTYPE!G,HYBRIDTYPE!G; 
LET OLDNG,CTSTOPG = NIL,CTSTOP!G;
LET TOTALNEWBONDS,TOTALMODABONDS = 0,0

static $(
ADDLB = NIL; 
CTSG = NIL;
DELUM = NIL;
DELUMBO = NIL; 
FAILED = NIL; 
GBO = NIL; 
GDEG = NIL; 
GNBR = NIL; 
GUM = NIL;
GUMANY = NIL; 
GUMBO = NIL; 
MAXJOIN = NIL; 
MAXJOIN0 = NIL;
NEWAR = NIL; 
NEWHMAX = NIL; 
NEWHMIN = NIL; 
NEWHYB = NIL;
NEWUMARKS = NIL;
NJOIN = NIL; 
ONBR = NIL; 
PBO = NIL;
PNBR = NIL; 
PTR = NIL; 
PTRTOP = NIL;
VLEFT = NIL 
$)

  /* G hasn't been mapped yet, start checking lots of atom properties to
   determine if appropriate to map P<=>G.
  */


  /* Atom type. */
  UNLESS TESTELEM(ATTYPEG,ATTYPEP) THEN RETURN

  /* H-range. */
  NEWHMIN:=(HMINP>HMING -> HMINP,HMING);
  NEWHMAX:=(HMAXP<HMAXG -> HMAXP,HMAXG);
  IF NEWHMIN>NEWHMAX THEN RETURN

  /* Aromatic character. */
  NEWAR:=ARTYPEG BITAND ARTYPEP;
  IF NEWAR=0 THEN RETURN

  /* Hybridisation. */
  NEWHYB:=HYBRIDTYPEG BITAND HYBRIDTYPEP;
  IF NEWHYB=0 THEN RETURN


  /* Uniqueness marks (COLOUR tags). */
  NEWUMARKS:=UMARKSP BITAND UMARKSG
  if NEWUMARKS=0 THEN RETURN

  /* Now see if node G can take all the bonds required by P. */
  PTR:=CTSTART!G-1;
  PTRTOP:=CTSTOPG;
  GDEG:=PTRTOP-PTR;
  VLEFT:=TYPEVALENCE!ATTYPEG-NEWHMIN;
  /* VLEFT is number of bonds that we are allowed to non-Hydrogen atoms,
  this mustn't be less than number needed.
  */
  IF VLEFT<PDEG THEN RETURN
  VLEFT-:=GDEG;
  /* (and also check that number of bonds to non-hydrogens already known (GDEG)
  not in conflict with valence and newly determind Hmin. */
  IF VLEFT<0 THEN RETURN

  /* "G" now seems OK wrt to atom properties and potential for more bonds.
  Better check if its the appropriate node to consider wrt symmetry.
  */
  OLDNG:=ORBREP(G);
  IF OLDNG<0 THEN RETURN; /* Its not appropriate by symmetry, try another. */

  /* Now some more complex checks on potential for additional bonds. */
  GUM:=0;
  GUMBO:=0;
  GUMANY:=FALSE;
  ONBR:=0;
  FAILED:=FALSE;
  WHILE PTR<PTRTOP DO
   $(
   PTR+:=1;
   GNBR:=CTABLE!PTR;
   TEST GNBR<0 THEN
    TEST MAPPEDTO![-GNBR]=0 THEN $( GUM+:=1; GUMBO+:=1; GUMANY:=TRUE $)
    OR BOSCRATCH![-GNBR]:=-1
   OR
    TEST MAPPEDTO!GNBR=0 THEN $( UNLESS GNBR=ONBR DO GUM+:=1; GUMBO+:=1 $)
    OR BOSCRATCH!GNBR+:=1;
   ONBR:=GNBR
   $);
  IF GUMANY DO GUMBO+:=VLEFT;
  DELUM:=PUM-GUM;
  DELUMBO:=PUMBO-GUMBO;
  ADDLB:=(DELUM>DELUMBO -> DELUM,DELUMBO);
  IF ADDLB<0 DO ADDLB:=0;
  VLEFT-:=ADDLB;
  MAXJOIN:=TOTB-ADDLB;
  IF MAXJOIN<0 DO $( FAILED:=TRUE; GOTO CLEANBOS $);
  IF VLEFT<MAXJOIN DO MAXJOIN:=VLEFT;
  MAXJOIN0:=MAXJOIN;
  NTOTM:=TOTM;
  NEWBPTR:=0;
  MODABPTR:=0;
   $(
   PNBR:=GLITABLE!PPTR;
   PPTR+:=1;
   IF PNBR=0 DO BREAK;
   TEST PNBR>0 THEN PBO:=1
   OR $( PBO:=GLITABLE!PPTR; PPTR+:=1; PNBR:=-PNBR $);
   GNBR:=MAPPEDTO!PNBR;
   GBO:=BOSCRATCH!GNBR;
   NJOIN:=ABS[PBO]-ABS[GBO];
   IF NJOIN<0 DO NJOIN:=0;
   MAXJOIN-:=NJOIN;
   IF MAXJOIN<0 DO $( FAILED:=TRUE; GOTO CLEANBOS $);
   NTOTM-:=(GBO=0 -> NJOIN-1,NJOIN);
   IF NTOTM<0 DO $( FAILED:=TRUE; GOTO CLEANBOS $);
   IF [TYPEVALENCE![ATTYPE!GNBR]-HMIN!GNBR-CTSTOP!GNBR+CTSTART!GNBR-1]<NJOIN DO
    $( FAILED:=TRUE; GOTO CLEANBOS $);
   TEST PBO=-1 THEN UNLESS GBO=0 DO LOOP
   OR IF GBO>0 DO TEST GBO=PBO THEN LOOP OR $( FAILED:=TRUE; GOTO CLEANBOS $);
   TEST GBO=0 THEN
    $(
    NEWBPTR+:=2;
    NEWBONDS![NEWBPTR-1]:=GNBR;
    NEWBONDS!NEWBPTR:=PBO
    TOTALNEWBONDS+:=ABS PBO
    $)
   OR
    $(
    MODABPTR+:=2;
    MODABONDS![MODABPTR-1]:=GNBR;
    MODABONDS!MODABPTR:=PBO
    TOTALMODABONDS+:=(PBO-1)
    $)
   $) REPEAT;


CLEANBOS:
  PTR:=CTSTART!G-1;
  WHILE PTR<PTRTOP DO $( PTR+:=1; BOSCRATCH![ABS[CTABLE!PTR]]:=0 $);
  IF FAILED DO
   $(
   UNORBREP(G,OLDNG);
   RETURN
   $);
  NJOIN:=MAXJOIN0-MAXJOIN;
  VLEFT-:=NJOIN;
  NTOTB:=TOTB-NJOIN;
  IF VLEFT<[NEWHMAX-NEWHMIN] DO NEWHMAX:=NEWHMIN+VLEFT;
  NTOTHMIN:=TOTHMIN+NEWHMIN-HMING;
  NTOTHMAX:=TOTHMAX-HMAXG+NEWHMAX;
  UNLESS NTOTHMIN LE HCOUNT LE NTOTHMAX DO
   $(
   UNORBREP(G,OLDNG);
   RETURN
   $);


  CONSTRUCTASSIGN(P,G,NEWHMIN,NEWHMAX,NEWAR,NEWHYB,NEWUMARKS,TOTALNEWBONDS,TOTALMODABONDS)

  GLSTEP(PPTR);					/* <==RECURSION *******  */

  DEASSIGN(P,G,CTSTOPG,UMARKSG,HMING,HMAXG,ARTYPEG,HYBRIDTYPEG,OLDNG,TOTALNEWBONDS,TOTALMODABONDS)
 
$)

and GLSTEP(PPTR) BE $(glstp
 /* 		Constructive Graph Matcher

	This version of the Graph-Matcher builds bonds if any are required
 to complete the match. It is called recursively for each atom in the current
 part of the GLI-item being injected.

 */

 STATIC $( GLTSTRT = NIL $)
 let ONEATPROPS = NIL

 let P=GLITABLE!PPTR;
 let GIX,G = NIL,NIL;
  
 IF P=0 DO $( 
	/* Have finished with this GLI part, check matching obtained. */
	ONEATPROPS:=SAVEONEATPROPS()
	PROCGLIMATCH(); 
	RESTOREONEATPROPS(ONEATPROPS)
//          TIMINGS!TIMEGL+:=MSRUNTIME()-GLTSTRT
	RETURN $);



 IF GLITABLE!(PPTR+4)=0 THEN GLTSTRT:=MSRUNTIME()

 /* Call to IMGFLOOR() identifies first CONGENPART node which can be mapped
 to P (involves consideration of symmetries), IMGFLOOR in fact returns
 X-1 where X is first allowed node. */


 GIX:=IMGFLOOR(P);


 WHILE GIX<NCGPNDS DO
  $(GraphNodes
  GIX+:=1;
  G:=CGPNUMBINV!GIX;
  /* G is index number of the candidate node now being considered. */
  if MAPPEDTO!G=0 DO CONSTRUCTMATCH(G,P,PPTR+4)
  $)GraphNodes
 $)glstp




AND PROCGLIMATCH() BE $(prcglmtch
 /* Have a number of checks on graph resulting from imbedding of the
 GLI item. One example of things checked is implications regarding
 maximum number of Hydrogens on atoms.
 */

 STATIC $( TOTHMAX2 = NIL; HFREEDOM = NIL;
              ND = NIL; HMX2 = NIL; HMN = NIL; 
              NEWTOTM = NIL; 
              HIGHMINNONHV = NIL; COMPIX = NIL; CHMAX = NIL; CFREEV = NIL;
              COMP = NIL; COMPSZ = NIL; MINNONHV = NIL; LCMP = NIL; LCMPV = NIL;
              SPTR0 = NIL; BASHMIN2 = NIL; HMX = NIL; HMN2 = NIL; PTR = NIL;
              PTRTOP = NIL; NDIMG = NIL; PTR2 = NIL; CHMIN = NIL;
              CFREEH = NIL $);


 LET SAVEDHS,SAVEDANYS,OLDTOTM,SAVEDMAP,SAVEDHYBS,SAVEDAROMS=NIL,NIL,NIL,NIL,NIL,NIL;
 LET XTIME = NIL;

//?  XTIME:=MSRUNTIME()
COUNTPROCGLIMATCH+:=1


//  OUTS("*C*LPROCGLIMATCH CALLED*C*L");
// HMAX2:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;
// NDFREEV:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;

 TOTHMIN:=0
 for ND=CGPSTART to CGPSTOP do TOTHMIN+:=HMIN!ND

 TOTHMAX2:=0;
 HFREEDOM:=HCOUNT-TOTHMIN;
 ND:=CGPSTART-1;


 /* Recompute limits on number of hydrogens that may be attached to 
 any particular atom.
 */
 WHILE ND<CGPSTOP DO
  $(
  ND+:=1;
  HMN:=HMIN!ND;
  HMX2:=TYPEVALENCE![ATTYPE!ND]-CTSTOP!ND+CTSTART!ND-1;
  IF HMX2<HMN DO $( 
// FREE1(); 
//?     TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME; 
    RETURN $);
  NDFREEV!ND:=HMX2-HMN;
  IF HMAX!ND<HMX2 DO HMX2:=HMAX!ND;
  IF HMX2-HMN>HFREEDOM DO HMX2:=HMN+HFREEDOM;
  HMAX2!ND:=HMX2;
  TOTHMAX2+:=HMX2
  $);

 IF TOTHMAX2<HCOUNT DO $( 
//	FREE1(); 
//? 	TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME; 
	RETURN $);


 COMPS:=COMPONENTS(CGPSTART,CGPSTOP);
 NCOMP:=COMPS!0;
 NEWTOTM:=TOTB-NCOMP+1;
 IF NEWTOTM<0 DO $( FREE2(); 
//? 	TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME; 
	RETURN $);
 REDHMAX:=NEWVEC(NCOMP);
 TOTCOMPHMAX:=0;
 HIGHMINNONHV:=-1;
 COMPIX:=0;


 WHILE COMPIX<NCOMP DO
  $(
  COMPIX+:=1;
  CHMAX:=0;
  CHMIN:=0;
  CFREEV:=0;
  COMP:=COMPS!COMPIX;
  COMPSZ:=COMP!0;
  WHILE COMPSZ>0 DO
   $(
   ND:=COMP!COMPSZ;
   COMPSZ-:=1;
   CFREEV+:=NDFREEV!ND;
   CHMIN+:=HMIN!ND;
   CHMAX+:=HMAX2!ND
   $);


  IF CFREEV=0 DO UNLESS NCOMP=1 DO $( FREE3(); 
//? 	TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME; 
	RETURN $);


  CFREEH:=CHMAX-CHMIN;
  TEST [CFREEH=CFREEV] BITAND [NCOMP>1] THEN
   $( REDHMAX!COMPIX:=1; CHMAX-:=1; CFREEH-:=1 $)
  OR REDHMAX!COMPIX:=0;
  MINNONHV:=CFREEV-(CFREEH>HFREEDOM -> HFREEDOM,CFREEH);
  IF HIGHMINNONHV<MINNONHV DO
   $( HIGHMINNONHV:=MINNONHV; LCMP:=COMPIX; LCMPV:=CFREEV $);
  TOTCOMPHMAX+:=CHMAX
  $);
 IF HIGHMINNONHV>TOTB DO
  IF CANLOOP(COMPS!LCMP,LCMPV,NDFREEV)<[HIGHMINNONHV-TOTB] DO $( FREE3(); 
//? 		TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME; 
		RETURN $);
 IF TOTCOMPHMAX<HCOUNT DO $( FREE3(); 
//? 		TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME; 
		RETURN $);

 /* Mods by NABG, include a couple of simple checks on validity of things
 like AROMATIC/HYBRID tags. */
 UNLESS VALIDATEATOMPROPERTIES(NEWTOTM) DO $( FREE3(); 
//? 		TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME; 
		RETURN $)

 UNLESS ADDMATCH() DO $( FREE3(); 
//? 		TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME; 
		RETURN $);


/* OLD CODE HERE : */

  IF FIRSTBUILTMATCH=NMATCH<MAXMATCH DO
    $( FGLN:=GLITABLE!0; FGLNLIM:=CGPNUMBERING![MAPPEDTO!FGLN]-1 $);

/* NEW CODE HERE : */
// FGLNLEV+:=1
//  FGLNSAV!FGLNLEV:=FGLNLIM
//  FGLN:=GLITABLE!0; 
// FGLNLIM:=CGPNUMBERING![MAPPEDTO!FGLN]-1;

 SAVEDHS:=CHANGEHRANGES()
 if VALIDATEATOMPROPERTIES(NEWTOTM) then $(
   /* Ran into problems in cases where changing H-s implied yet
 further restrictions on hybiridization. This was not being
 recognised and got duplicate structures (with meaningless variations
 in allowed hybridizations).
 Hence this patch where hybiridization recomputed after h-range changes
 made.
 */

    SAVEDHYBS:=SAVEHYBRIDS()
    SAVEDAROMS:=SAVEAROMS()
    SAVEDANYS:=STRIPANYS(NEWTOTM);
    SAVEDMAP:=SAVEMAPPING();
   
   
    OLDTOTM:=TOTM;
    TOTM:=NEWTOTM;
   
   
    TEST NMATCH=MAXMATCH THEN
     IF TESTPATMAXS() DO $(PATSOK
		/* NEED TO SCORE STRUCTURE IF IN ALTERNATIVES MODE, OR
		GENERATING WITH A MINIMUM SCORE TEST.
		*/

		IF (MODE GE 3) | ((MODE EQ 1) & (MINGENERATESCORE GR MINUSINF)) THEN 
			SCORECGP(); 


		/* IF GENERATING WITH MINIMUM SCORE TEST THEN MUST
		CHECK THAT OK.
		*/
		
		TEST ((MODE EQ 1) & (MINGENERATESCORE GR MINUSINF)) THEN $(CHKMINSCR
	        	/* Check resulting score greater than minimum required. */
			if (MINGENERATESCORE LS (NEWBELIEF-NEWDISBELIEF)) & UNIQUECGP() DO $( 
				WRITECGP() 
				CHECKUSERCONTROL(TRUE)
			$)CHKMINSCR
		OR IF UNIQUECGP() DO $( 
			WRITECGP() 
			CHECKUSERCONTROL(TRUE)
			$)
		$)PATSOK
    OR GLSTEP(0);
   
   
    TOTM:=OLDTOTM;
    RESTOREMAP(SAVEDMAP)
    RESTOREANYS(SAVEDANYS)
    RESTOREAROMS(SAVEDAROMS)
    RESTOREHYBRIDS(SAVEDHYBS)
    $)
 RESTOREHRANGES(SAVEDHS)

 IF MAXMATCH>1 DO FREEVEC(MATCHES!NMATCH);
/* OLD FGLN CODE HERE : */

 IF FIRSTBUILTMATCH=NMATCH DO $( FGLN:=0; FGLNLIM:=0 $);

/* NEW FGLN CODE HERE : */

// FGLNLIM:=FGLNSAV!FGLNLEV
// FGLNLEV-:=1
// IF FGLNLEV=0 DO FGLN:=0


 NMATCH-:=1

//?  TIMINGS!TIMEPRCGLI+:=MSRUNTIME()-XTIME
$)prcglmtch

/*


		SIMPLE STRUCTURE GENERATING FUNCTIONS.

	FORMBONDS/FINDBONDS together form the simple final structure
generator that produces all possible complete structures from each
individual CASE (CONGEN-PROBLEM-PART). FINDBONDS finds ways of assigning
remaining bonds to connect together atoms in the current CGP, each such
assignment is passed in turn to FORMBONDS. FORMBONDS does the actual
modifications to the CTABLE data structure etc and passes the resulting
structure to PROCGLIMATCH (where it will be checked to see that it
doesn't violate any maxima constraints, checked for uniqueness and
written to the results file if appropriate).

*/


LET FORMBONDS(NBONDS,NDI,NDJ,MULTIP) BE $(FormBnds

 /* FORMBONDS has to insert a total of NBONDS, NDI/NDJ define the index
 numbers of the atoms being joined and MULTIP gives the multiplicity.
 Thus second of bonds to be formed would go from NDI!2 to NDJ!2 and
 should have multiplicity MULTIP!2. The entries in NDI and NDJ will
 be negative if, before this particular choice of bonds made, the
 CGP had an any bond between these nodes; modification and restoration
 of ANY bonds in the CONGEN-PROBLEM-PART requires some special handling. */

 STATIC $( IBOND = NIL; NI = NIL; NJ = NIL; MULT = NIL; TOPI = NIL;
              TOPJ = NIL $);
//? OUTS("*C*LInserting bonds.*C*L")
COUNTFORMBONDS+:=1
 IBOND:=0;
 WHILE IBOND<NBONDS DO
  $(PutinBnds
  IBOND+:=1;
  NI:=NDI!IBOND;
  NJ:=NDJ!IBOND;
  MULT:=MULTIP!IBOND;
//? OUTS("From "); OUTNOS(NI); OUTS(" to "); OUTNOS(NJ);
//? OUTS(", multiplicity "); OUTNOL(MULT)

  IF NI<0 DO $(AnyBnd
	REMANY(-NI,-NJ,MULT); 	
	REMANY(-NJ,-NI,MULT); 
//? OUTS("(that changed an ANY bond)*C*L")
	LOOP $)AnyBnd

  /* Ordinary case, no ANY bonds, just have to insert MULT new bonds
  between NI and NJ. Simply put data into CTABLE and update CTSTOP ptrs.
  */
  TOPI:=CTSTOP!NI;
  TOPJ:=CTSTOP!NJ;

  WHILE MULT>0 DO
   $(OneNewBond
   MULT-:=1;
   TOPI+:=1;
   TOPJ+:=1;
   CTABLE!TOPI:=NJ;
   CTABLE!TOPJ:=NI
   $)OneNewBond

  CTSTOP!NI:=TOPI;
  CTSTOP!NJ:=TOPJ
  $)PutinBnds

 /* Check, and if necessary output resulting structure. */
//? OUTS("Calling PROCGLIMATCH now *C*L")
 PROCGLIMATCH();

 /* Restore CTABLE etc to original condition by removing the bonds just
 inserted.
 */

 IBOND:=NBONDS;
 WHILE IBOND>0 DO
  $(TakeOutAgain
  NI:=NDI!IBOND;
  NJ:=NDJ!IBOND;
  IF NI<0 DO $(AnyBnd
	PUTANY(-NI,-NJ); 
	PUTANY(-NJ,-NI); 
	IBOND-:=1; 
	LOOP $)AnyBnd

  MULT:=MULTIP!IBOND;
  CTSTOP!NI-:=MULT;
  CTSTOP!NJ-:=MULT;
  IBOND-:=1
  $)TakeOutAgain

$)FormBnds




LET FINDBONDS() BE $(fndbnds
 /* FINDBONDS, the function for finding all possible assignments of
 remaining unused bonds in an incomplete CONGEN-PROBLEM-PART, is limited
 to doing a little initialisation, setting up vectors for work space
 etc. The real work is done within the recursive function FIND1() which
 calls itself recursively for each successive bond that must be
 assigned.
 */

 STATIC $( ND = NIL; REMDEG = NIL; PTR = NIL; HLIM = NIL;
              PTRTOP = NIL; NDI = NIL; NDJ = NIL; MULTIP = NIL;
              NBR = NIL; BCOUNT = NIL; BOSIGN = NIL $);

/* Additional code added by NABG, it was observed that this
function was generating disconnected structures, new routines
OKTOBOND and PARTFVS added to check and attempt to avoid such
cases.
*/


let NEWHYBRIDTYPE(NI) = valof $(nhyb
/* It was observed that numerous solutions were being created
that violated local hybridtype and aromatic type constraints
known to apply to various atoms. This function is used as 
a crude filter to eliminate some of the solutions that are
more obviously incompatible with local one atom constraints.
*/
static $( PTR = NIL; PTRTOP = NIL; NBR = NIL; ONBR = NIL;
PIELECTRONS = NIL; SIGMAELECTRONS = NIL; VLNC = NIL $)

VLNC:=TYPEVALENCE![ATTYPE!NI]


PTR:=CTSTART!NI - 1;
PTRTOP:=CTSTOP!NI;

SIGMAELECTRONS:=HMIN!NI
PIELECTRONS:=0

ONBR:=0

until PTR=PTRTOP do $(fixedbonds
	PTR+:=1;
	NBR:=ABS (CTABLE!PTR)
	test NBR=ONBR then PIELECTRONS+:=1
	or SIGMAELECTRONS+:=1
	ONBR:=NBR
	$)fixedbonds

for B=1 to BCOUNT do $(newbonds
	if ((NI = (ABS (NDI!B))) | (NI = (ABS (NDJ!B)))) then $(thisone
		PIELECTRONS+:=MULTIP!B-1
		unless NDI!B LS 0 do SIGMAELECTRONS+:=1
		$)thisone
	$)newbonds

//? OUTS("Checking valence/hybridization of atom "); OUTNOS(NI)
//? OUTS(" sigma and pi electrons seem to be : "); OUTNOS(SIGMAELECTRONS)
//? OUTNOL(PIELECTRONS)

test VLNC = (SIGMAELECTRONS+PIELECTRONS) then $(fixed
	test PIELECTRONS=0 then resultis SP3
	or
	test PIELECTRONS=1 then resultis SP2
	or
	resultis (SP1A | SP1B)
	$)fixed
or resultis (SP3 | SP2 | SP1A | SP1B)

$)nhyb


let ATPROPCHK(NI) = valof $(apchk
/* currently only atom property being considered is hybridization,
(modifications in code to determine atom "I" eliminated
generation of most structures with invalid H ranges).
*/
resultis (HYBRIDTYPE!NI BITAND NEWHYBRIDTYPE(NI))
$)apchk

let PARTFVS(NI,CMP) = valof $(pfvs       
    /* Find connected component containing atom NI, determine
   if any atom in it has some free valences left, if so then
   return TRUE else FALSE.
   */
   static $( NICMP = NIL $)
   NICMP:=CMP!NI
   for I=CGPSTART to CGPSTOP do
     if (CMP!I=NICMP) & (REMDEG!I > 0) then resultis TRUE
//?  OUTS("Find no fvs on component "); OUTNOS(NICMP)
//?  OUTS(" when checking on atom "); OUTNOL(NI)
   resultis FALSE
   $)pfvs

let OKTOBOND(NI,NJ,TOTB,CMP) = valof $(ktbnd
   if TOTB = 0 then resultis TRUE
   if REMDEG!NI > 0 then resultis TRUE
   if REMDEG!NJ > 0 then resultis TRUE
   if PARTFVS(NI,CMP) then resultis TRUE
   if PARTFVS(NJ,CMP) then resultis TRUE
//?  OUTS("Think it impossible to bond "); OUTNOS(NI)
//?  OUTS(" to "); OUTNOS(NJ)
//?  OUTS(" without creating disconnected component*C*L")
    resultis FALSE
   $)ktbnd


let VALENCELIMCHK(II,HL) = valof $(vlchk
  /* Frequently, get situation where partial solution implies
either too many bonds on, or too many Hs on remaining atoms
with free valences. This function traps more obviously
gross situations.
*/
 static $( HC = NIL; NI = NIL; ATOMCOUNT = NIL; MULTCOUNT = NIL $)
 HC:=0
 ATOMCOUNT:=0
 MULTCOUNT:=0
 for I=II to NCGPNDS do $(
	NI:=CGPNUMBINV!I
	unless REMDEG!NI GR 0 do loop
	HC+:=HMAX!NI-HMIN!NI
	ATOMCOUNT+:=1
	if REMDEG!NI GR 1 then MULTCOUNT+:=1
	$)

 if HC LS HL then resultis FALSE
 resultis ((TOTB EQ 0) | (MULTCOUNT GR 1) | (ATOMCOUNT GR TOTB))
$)vlchk



let FINDJ(PREVI,PREVJ,OCID,II,NHL) be $(fndj
   LET OLDNGJ,NJ=NIL,NIL;
   let CNJ,NEWC=NIL,NIL
   let NCID = NIL;
   let JJ = NIL;
   let NI=NIL;
   let CNI=NIL
    /* Have found first atom for bond, now find choices for
    atoms at other end of bond.
    */
//? OUTS("FINDJ now look for candidates for other end of bond.*C*L")
  NI:=CGPNUMBINV!II
  CNI:=OCID!NI
   NCID:=NEWVEC(CGPSTOP)
   
   JJ:=(II=PREVI -> (TOTM=0 -> PREVJ+1,PREVJ),II+1) 

    FOR J=JJ TO NCGPNDS DO
     $(Jloop
     NJ:=CGPNUMBINV!J;
     CNJ:=OCID!NJ
//?  OUTS("      considering as J node "); OUTNOL(NJ)
     UNLESS REMDEG!NJ>0 DO LOOP;
//?  OUTS("            this still has free valences.*C*L")
     OLDNGJ:=ORBREP(NJ);
//?  BUGCALL("in FIND1 finding node J*C*L")
     IF OLDNGJ<0 DO LOOP;
//?  OUTS("            it is an orbit rep.*C*L")
     PTR:=CTSTART!NI-1;
     PTRTOP:=CTSTOP!NI;
     BOSIGN:=0;
     WHILE PTR<PTRTOP DO
      $(Aretheybondednow
      PTR+:=1;
      NBR:=CTABLE!PTR;
      IF ABS[NBR]=NJ DO $( BOSIGN:=NBR; BREAK $)
      $)Aretheybondednow 

     /* Next test is to prevent program from turning single bonds into
     double bonds, doubles into triples etc. If NI and NJ are joined
     by a bond of definite order already represented in the CTABLE
     then BOSIGN>0 and have to find some other choice, so after tidying
     up changes made to symmetry groups (UNORBREP(NJ)) loop on to next
     choice.
     If NI and NJ are already joined by an ANY bond (BOSIGN<0) then its
     OK to add another bond PROVIDED that we have enough bonds around
     to connect up the structure and have multiple bonds (TOTM>0). If
     only have just enough bonds to join up the structure then TOTM=0
     and so can't permit multiple bond, again UNORBREP(NJ) and loop.
     */
     UNLESS BOSIGN=0 DO
      UNLESS [BOSIGN<0] BITAND [TOTM>0] DO $( 
//? OUTS("           but these already bonded and can't change bond order for them*C*L")
	UNORBREP(NJ,OLDNGJ); 
	LOOP $);


     REMDEG!NI-:=1;
     REMDEG!NJ-:=1;
     TOTB-:=1;
     NEWC:=(CNI < CNJ -> CNI, CNJ)
     for NDIX=CGPSTART to CGPSTOP do
       test (OCID!NDIX = CNI) | (OCID!NDIX = CNJ) then NCID!NDIX:=NEWC
       or NCID!NDIX:=OCID!NDIX

//? OUTS("Will Try bonding "); OUTNOS(NI); OUTNOL(NJ)
  if VALENCELIMCHK(II,NHL) &  OKTOBOND(NI,NJ,TOTB,NCID) then $(bndm
//  OUTS("seems OK.*C*L")
     TEST [II=PREVI] BITAND [J=PREVJ] THEN
      $(IncreaseBondOrder
      /* Forming another bond between same two atoms as in the recursive call
	to FIND1 to which we are currently subordinate.
	So, just increase order for that bond and reduce count of multiple
	bonds that may be made.
	The same code is applicable whether or not this is a completely new
	multiple bond or one developed by increasing the bond-order of an
	ANYBOND.
	Recursively call FIND1 to get next bond, then restore TOTM and
	order of bond BCOUNT.
      */
//?  OUTS("        increasing the bond order between these.*C*L")
      TOTM-:=1;
      MULTIP!BCOUNT+:=1;
      if (ATPROPCHK(NI) & ATPROPCHK(NJ)) then FIND1(II,J,NCID,NHL);
      MULTIP!BCOUNT-:=1;
      TOTM+:=1
      $)IncreaseBondOrder
     OR
      $(NewBond
//?  OUTS("       placing a new bond between previously unbonded atoms.*C*L")
      BCOUNT+:=1;
      TEST BOSIGN=0 THEN
       $(CompletelyNew
       /* Simplest case, NI and NJ weren't previously joined, now
	they are and the bond-order is 1.
       */
       NDI!BCOUNT:=NI;
       NDJ!BCOUNT:=NJ;
       MULTIP!BCOUNT:=1;
       if (ATPROPCHK(NI) & ATPROPCHK(NJ)) then FIND1(II,J,NCID,NHL)
       $)CompletelyNew
      OR
       $(OldAnyBnd
       /* Previously, NI and NJ were joined in the current CGP by an
	ANY bond, have now made it a bond of order at least 2. Slightly
	different data in NDI/NDJ etc as need to be able to keep track
        of any bonds.
       */
//?   OUTS("    changing an ANY bond into a bond of order at least 2.*C*L")
       NDI!BCOUNT:=-NI;
       NDJ!BCOUNT:=-NJ;
       MULTIP!BCOUNT:=2;
       TOTM-:=1;
       if (ATPROPCHK(NI) & ATPROPCHK(NJ)) then FIND1(II,J,NCID,NHL);
       TOTM+:=1
       $)OldAnyBnd
      BCOUNT-:=1
      $)NewBond
  $)bndm
//? OUTS("Finished with "); OUTNOS(NI); OUTS(" to "); OUTNOS(NJ); OUTS("link*C*L")
     TOTB+:=1;
     REMDEG!NI+:=1;
     REMDEG!NJ+:=1;
     UNORBREP(NJ,OLDNGJ)
     $)Jloop

  FREEVEC(NCID)

$)fndj


and FINDI(PREVI,PREVJ,OCID,HL,I) be $(fndI
   /* Otherwise continue by looking for an assignment for the next
   bond that must be made. Last bond selected was from PREVI to PREVJ, these
   provide lower limits on node numbers that remain to be considered.
   */
   let OLDNGI = NIL
   LET NI=NIL;
   let CNI=NIL
   let II = NIL
   let NHL = HL;
   let SUM = NIL;
   let HS = NIL
   let HN = NIL

/* Changes by NABG, algorithm was looping through all nodes, but
 unless take, for next NI, the next atom with fvs we can't get
 any legal solution for leaving out some atom with fvs means won't
 find places for all bonds.
 (If can have fvs to H's thats different though)
*/

  if I GR NCGPNDS then return

  II:=I

  NI:=CGPNUMBINV!II


  CNI:=OCID!NI

  unless REMDEG!NI>0 do $( FINDI(PREVI,PREVJ,OCID,HL,1+II); return $)
  OLDNGI:=ORBREP(NI)

  if OLDNGI < 0 do $( FINDI(PREVI,PREVJ,OCID,HL,1+II); return $)

//? OUTS("FINDI considering node "); OUTNOL(NI)
//? OUTS("it still has free valences.")


  FINDJ(PREVI,PREVJ,OCID,II,NHL) 

  HS:=HMAX!NI - HMIN!NI
  unless HS GE REMDEG!NI do $( UNORBREP(NI,OLDNGI); return $)
  HN:=((REMDEG!NI LS HS) -> REMDEG!NI, HS)
  unless NHL GE HN do $( UNORBREP(NI,OLDNGI); return $)
  SUM:=0
  for ND=1 to NCGPNDS do
	if OCID!ND=CNI then SUM+:=REMDEG!ND

  unless SUM > HN do $( UNORBREP(NI,OLDNGI); return $)

//? OUTS("Trying to put "); OUTNOS(HN); OUTS("hydrogen(s) on node "); OUTNOL(NI)

  /* Try filling a free valence on NI with a hydrogen. */
  NHL-:=HN
  HMIN!NI+:=HN
  REMDEG!NI-:=HN
  if ATPROPCHK(NI) then FINDI(PREVI,PREVJ,OCID,NHL,II+1)
  REMDEG!NI+:=HN
  HMIN!NI-:=HN
  NHL+:=HN
  UNORBREP(NI,OLDNGI) 



$)fndI


and FIND1(PREVI,PREVJ,OCID,HL) BE $(FindNxt1
  /* If no more bonds to be found, call FORMBONDS to process the current
  selection.
  */

 let II = NIL;

 COUNTFIND1+:=1
 test TOTB=0 then FORMBONDS(BCOUNT,NDI,NDJ,MULTIP)
 or $(
     II:=(PREVI=0 -> 1,PREVI)
     FINDI(PREVI,PREVJ,OCID,HL,II)
    $)

$)FindNxt1


//? OUTS(" STARTING TO FIND WHERE BONDS CAN BE PLACED.*C*L*L")
COUNTFINDBONDS+:=1

 BCOUNT:=0;
 /* Allocate arrays, and fill REMDEG (Remaining Degree) of each atom
 node with the maximum number of additional bonds that that atom can
 form.
 */

 REMDEG:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;
 NDI:=NEWVEC(TOTB);
 NDJ:=NEWVEC(TOTB);
 MULTIP:=NEWVEC(TOTB);
 ND:=CGPSTART-1;
 HLIM:=HCOUNT

 WHILE ND<CGPSTOP DO
  $(whND
  ND+:=1;
  /* ND is of type ATTYPE!ND, hence its valence is TYPEVALENCE![ATTYPE!ND],
  HMIN!ND of its bonds must go to hydrogens, 
  its already had ((CTSTOP!ND)- ((CTSTART!ND)-1)) bonds formed and
  defined in the CTABLE,
  hence REMDEG.
  */

  REMDEG!ND:=TYPEVALENCE![ATTYPE!ND]-CTSTOP!ND+CTSTART!ND-1-HMIN!ND;
  HLIM-:=HMIN!ND
  $)whND


 /* Call FIND1 to discover all possible ways of assigning the remaining bonds.
 */
 FIND1(0,0,COMPONENTID,HLIM);

 /* Free work space vectors etc. */
 FREEVEC(MULTIP);
 FREEVEC(NDJ);
 FREEVEC(NDI);
 FREEVEC(REMDEG+CGPSTART)
 $)fndbnds



let NONECONSTRAINT() be $(NBLD
  static $( CANONNO = NIL; ND = NIL $)
  /* The current pattern is of the form "NONE", so all that
  must be done is check maximum limits of patterns (TESTPATMAXS),
     Its also possible to be using this code if get a set of ALTERNATIVES
  everyone of which is associated with a negative score.
     If in CONSTRAINT mode, just check each case (CGP) against the patterns
  and if OK then output with same score.
     If in ALTERNATIVES mode, same but have to rescore structure.
  */
  NEWBELIEF:=OLDBELIEF
  NEWDISBELIEF:=OLDDISBELIEF
  CURRENTPATREC:=0;
  FGLN:=0;
  FGLNLIM:=0;
  ND:=CGPSTOP;
  CANONNO:=NCGPNDS;
  WHILE CANONNO>0 DO
   $(whCANON
   CGPNUMBERING!ND:=CANONNO;
   CGPNUMBINV!CANONNO:=ND;
   BOSCRATCH!ND:=0;
   ND-:=1;
   CANONNO-:=1
   $)whCANON
  TEST TESTPATMAXS() THEN $(
	NSTRUCS+:=1; 
	if MODE GE 3 then SCORECGP()
	WRITECGP() 
	CHECKUSERCONTROL(TRUE)
	$) 
  OR OUTCHP('**')
  $)NBLD



let CONSTRAINT(PATREC) be $(cons
 /* This function applies PATREC as a constraint, its used either
 for the single special pattern in CONSTRAINT mode; or is called
 once for each of the different patterns in ALTERNATIVES mode.
 */

//? OUTS("*C*LGRAPH MATCHING STARTS:*C*L*L")

   FGLN:=0;
   FGLNLIM:=0;
   NMATCH:=0
   NEWBELIEF:=OLDBELIEF
   NEWDISBELIEF:=OLDDISBELIEF
   SETUPPAT(PATREC);
   GMSTEP(0);
   FIRSTBUILTMATCH:=NMATCH+1;
   TEST NMATCH<MAXMATCH THEN $( 
      //? OUTS("*C*LGRAPH CONSTRUCTION STARTS*C*L*L")
      GLSTEP(0)
      $)
   OR IF TESTPATMAXS() DO 
	IF UNIQUECGP() DO $( 
		IF MODE GE 3 THEN SCORECGP(); 
		WRITECGP() 
		CHECKUSERCONTROL(TRUE)
		$)
   IF MAXMATCH>1 DO
    WHILE NMATCH>0 DO $( FREEVEC(MATCHES!NMATCH); NMATCH-:=1 $)
$)cons



let BLEACHING() be $(chlorox
 /* Color tags on atoms of cases have surved their purpose and should
 now be removed. When color distinctions thus lost may find some
 supposedly distinct structures are in fact identical.
 */

//? OUTS("*C*LBLEACHING PROCESS STARTS:*C*L*L")

   NEWBELIEF:=OLDBELIEF
   NEWDISBELIEF:=OLDDISBELIEF
   
/* Reset colors to #7777 */
   for ND = CGPSTART to CGPSTOP do UMARKS!ND:=#7777;

   IF UNIQUECGP() DO $(
	WRITECGP() 
	CHECKUSERCONTROL(TRUE)
	$)
$)chlorox



LET INTERP() BE $(ntrp

static $(
CGPCOMPS = NIL; 
NCOMP = NIL; 
COMP = NIL; 
COMPSZ = NIL;
ND = NIL; 
TOTUSEDV = NIL; 
COMPREC = NIL; 
COMPIX = NIL;
CANONNO = NIL 
$)

 NCGPNDS:=CGPSTOP-CGPSTART+1;
 CGPNUMBERING:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;
 COMPONENTID:=NEWVEC(CGPSTOP)
 CGPNUMBINV:=NEWVEC(NCGPNDS);
 BOSCRATCH:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;
 TEST NOBUILD THEN NONECONSTRAINT()
 OR
  $(Bld
  TOTUSEDV:=0;
  TOTHMIN:=0;
  TOTHMAX:=0;
  CANONNO:=0;
  /* Find a canonical representation for the current CONGEN problem part (CASE)
  */

  CGPCOMPS:=CANONCOMPS(CGPSTART,CGPSTOP,CGPATPROPS,GSCRATCH);
//? OUTS("DATA on current CASE:*C*L")
//? BUGTABLES(1,CGPSTART,CGPSTOP)
//? BUGTABLES(2,CGPSTART,CGPSTOP)
//? BUGTABLES(3,CGPSTART,CGPSTOP)
//? BUGSYMTABLES(CGPCOMPS,TRUE)

//? OUTS("Canonical numbering for 'CASE'*C*L"); 
//? OUTS("Node  Sequence #*C*L")


  /* Build records identifying the component in the CONGEN problem part 
  containing each node of the CONGEN problem part (PARENTCOMP).
  */

  PARENTCOMP:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;
  COMPOFFSET:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;
  NCOMP:=CGPCOMPS!0;
  COMPIX:=0;
  WHILE COMPIX<NCOMP DO
   $(whCOMPIX
   COMPIX+:=1;
   COMPREC:=CGPCOMPS!COMPIX;
   COMP:=COMPREC!0;
   COMPSZ:=COMP!0;
   NDIX:=0;
   WHILE NDIX<COMPSZ DO
    $(whNDIX
    NDIX+:=1;
    ND:=COMP!NDIX;
    COMPOFFSET!ND:=NDIX;
    CANONNO+:=1;
    CGPNUMBERING!ND:=CANONNO;

//? OUTNOS(ND); OUTNOL(CANONNO)

    CGPNUMBINV!CANONNO:=ND;
    PARENTCOMP!ND:=COMPREC;
    COMPONENTID!ND:=COMPIX
    BOSCRATCH!ND:=0;
    TOTHMIN+:=HMIN!ND;
    TOTHMAX+:=HMAX!ND;
    TOTUSEDV+:=CTSTOP!ND-CTSTART!ND+1
    $)whNDIX
   $)whCOMPIX

//   OUTS("CGPNUMBINV : *C*L")
//   for III=CGPSTART to CGPSTOP do $(iii
// 	OUTNOS(III); OUTNOL(CGPNUMBINV!III)
// 	$)iii

  TOTB:=TOTB0-[TOTUSEDV/2];
  TOTM:=TOTB-[NCOMP-1];
  MAXMATCH:=(GENERATING | BLEACH -> 1,PATMINS!1);
  MATCHES:=NEWVEC(MAXMATCH);
  SWITCHON MODE INTO $(MDSW
	case 0: /* "bleach", just remove color tags */
	   BLEACHING();
	   endcase;
	CASE 1: /* GENERATING */
	   CURRENTPATREC:=0;
	   FIRSTBUILTMATCH:=0;
	   NMATCH:=0;
	   FINDBONDS()
	   ENDCASE;
	CASE 2:
	   CONSTRAINT(PATRECS!1)
	   ENDCASE;
	DEFAULT:
	   FOR I1=1 TO SPECIALPATS DO 
		IF SUBSCORES!I1 GE 0 THEN CONSTRAINT(PATRECS!I1)
	$)MDSW
  FREEVEC(MATCHES);
  FREEVEC(COMPOFFSET+CGPSTART);
  FREEVEC(PARENTCOMP+CGPSTART);
  FREECC(CGPCOMPS,TRUE)
  $)BLD
 FREEVEC(BOSCRATCH+CGPSTART);
 FREEVEC(CGPNUMBINV);
 FREEVEC(COMPONENTID)
 FREEVEC(CGPNUMBERING+CGPSTART)
 $)ntrp
$NOLIST

/* These funtions allow manipulation of data in segmented files like
 the "TOP" file.
    Special seperator characters + "key word" strings are used to
    define the segments in such files. The separator characters are
    CHUNKSEP (which is actually a page mark) and ESSEP (which is the
    tab character). 
   These functions not much importance, accessed when recreating a
  new version of the TOP file with info on the number of Cases generated
  details of the latest constraint applied etc.

*/
STATIC $( MFHEADSTR = "MOLFORM"; SSHEADSTR = "STRUCSTATUS";
          ESHEADSTR = "ESSTRUCS"; ARHEADSTR = "AROMATICS";
          HIHEADSTR = "HISTORY"; TTHEADSTR = "TERMTYPE" $);

LET COPYSEG(SEPCHAR,INCLUDESEP) BE
 $( STATIC $( CHAR = NIL $);
 CHAR:=INCH();
 WHILE CHAR NE SEPCHAR DO $( OUTCH(CHAR); CHAR:=INCH() $);
 IF INCLUDESEP DO OUTCH(CHAR)
 $);

LET SKIPSEG(SEPCHAR) BE
 $( STATIC $( CHAR = NIL $);
 CHAR:=INCH() REPEATUNTIL CHAR=SEPCHAR
 $);

LET FINDSEG(SEPCHAR,STR) = VALOF
 $( STATIC $( FILESTR = NIL; INDEX = NIL $);
 INDEX:=0;
  $(
  SKIPSEG(SEPCHAR);
  FILESTR:=INS0(TRUE);
  IF NCHARS(FILESTR)=0 DO RESULTIS -INDEX;
  IF STREQUAL(FILESTR,STR) DO RESULTIS INDEX+1;
  INDEX:=INDEX+1
  $) REPEAT
 $);

LET COPYSEGSTO(SEPCHAR,STR,INCLUDESTR) = VALOF
 $( STATIC $( FILESTR = NIL $);
 COPYSEG(SEPCHAR,TRUE);
 FILESTR:=INS0(TRUE);
 IF NCHARS(FILESTR)=0 DO RESULTIS FALSE;
 TEST STREQUAL(FILESTR,STR) THEN
  $(
  IF INCLUDESTR DO $( OUTS(FILESTR); NEWLINE(1) $);
  RESULTIS TRUE
  $)
 OR $( OUTS(FILESTR); NEWLINE(1) $)
 $) REPEAT;
$LIST

LET FETCHCGP() = VALOF $(FTCHCGP
 /* Read next "CASE" ("CONGEN-PROBLEM-PART"/CGP) from STR file,
 code is really quite implementation dependent here as all the numbers
 like 126 are the decimal values on the KI-10 computer for the various
 escape characters used to delimit particular items in the data file.
 */

 STATIC $( CTPTR = NIL; NBR = NIL; NDIX = NIL; 
              VFREE = NIL; SKIP = NIL; CGPND = NIL; DEG = NIL $);
 STRUCNUMBER:=0;
 INPUT:=INFILE;


NEXTSTRUC:
 SKIP:=FALSE;
 NBR:=[INCH()+80]REM 128;
 IF NBR=127 DO $( INPUT:=INSOURCE; RESULTIS FALSE $);
 IF NBR=126 DO $( STRUCNUMBER:=INNO(); 
	OLDBELIEF:=INNO(); 
	OLDDISBELIEF:=INNO();
	INCH(); NBR:=[INCH()+80]REM 128 $);
 CTPTR:=1;
 NDIX:=0;
 WHILE NBR NE 127 DO
  $(
  NDIX+:=1;
  CTSTART!NDIX:=CTPTR;
  TEST NBR=CGPNDSYM THEN
   $(
   ARTYPE!NDIX:=[INCH()+80] REM 128;
   HYBRIDTYPE!NDIX:=[INCH()+80] REM 128;
   UMARKS!NDIX:=[INCH()+80] REM 128;
   UMARKS!NDIX:=UMARKS!NDIX << 6
   UMARKS!NDIX+:=[INCH()+80] REM 128;
   if UMARKS!NDIX EQ 0 then UMARKS!NDIX:=#7777
   HMIN!NDIX:=[INCH()+80] REM 128;
   HMAX!NDIX:=[INCH()+80] REM 128;
   NBR:=[INCH()+80] REM 128;
   CGPND:=TRUE
   $)
  OR $( ARTYPE!NDIX:=1; CGPND:=FALSE $);
  UNTIL NBR=0 DO
   $(
   TEST NBR=125 THEN UNLESS CGPND DO ARTYPE!NDIX:=2
   OR
    TEST NBR=ANYBSYM THEN CTABLE![CTPTR-1]:=-[CTABLE![CTPTR-1]]
    OR $( CTABLE!CTPTR:=NBR; CTPTR+:=1 $);
   NBR:=[INCH()+80]REM 128
   $);
  CTSTOP!NDIX:=CTPTR-1;
  DEG:=CTPTR-CTSTART!NDIX;
  VFREE:=TYPEVALENCE![ATTYPE!NDIX]-DEG;
  TEST CGPND THEN
   TEST [HMIN!NDIX LE VFREE] THEN CTPTR+:=VFREE-HMIN!NDIX
   OR SKIP:=TRUE
  OR
   TEST VFREE<0 THEN SKIP:=TRUE
   OR $( HMIN!NDIX:=VFREE; HMAX!NDIX:=VFREE $);
  NBR:=[INCH()+80]REM 128
  $);
 IF SKIP DO $( OUTCHP('?'); GOTO NEXTSTRUC $);
 UNLESS NOBUILD DO OUTCHP('#');
 INPUT:=INSOURCE;
 RESULTIS TRUE
 $)FTCHCGP



let NEWTOP() be $(nwtp
/* Create a new top-file. */
 INPUT:=FINDFILE("DSK",TOPFILENAME(),CGEXT);
 OUTPUT:=CREATEFILE("DSK",SC2FILENAME(),CGEXT);
 COPYSEGSTO(CHUNKSEP,SSHEADSTR,TRUE);
 OUTNO(NSTRUCS); 
 test GENERATING & ABANDONED then OUTS(" PARTIAL*C*L")
 or NEWLINE(1)
 OUTNOS(1); OUTNOL(NSTRUCS); OUTNOS(U);
 FOR I=1 TO NTYPES DO
  IF [TYPENUM!I]>0 DO $( OUTS(TYPENAME!I); SPACES(1); OUTNOS(TYPENUM!I) $);
 NEWLINE(1);
 SKIPSEG(CHUNKSEP);
 OUTCH(CHUNKSEP);

/* Have now to update history list, it seems history should be thrown 
 away when structures generated (may change that sometime).
 Otherwise have to put in appropriate records,
  format for these depends a bit on whether it was a simple
  constraint, an alternative, or a special case of alternative like
  ion-composition.

 */

 COPYSEGSTO(CHUNKSEP,HIHEADSTR,TRUE);
 SWITCHON MODE INTO $(MDSW
	CASE 1: /* GENERATING, SO JUST RUB OUT HISTORY LIST. */
	  SKIPSEG(CHUNKSEP);
	  NEWLINE(1);
	  OUTCH(CHUNKSEP)
	  ENDCASE;
	CASE 2:
          if ABANDONED do OUTS(".ABORTED*C*L")
	  /* SINGLE CONSTRAINT PATTERN. */
	  OUTS(FIRSTPATNAME);
          OUTS(" N ");
          OUTNOS(PATMINS!1);
          OUTNOL(PATMAXS!1)
	  ENDCASE;
	CASE 3:
          if ABANDONED do OUTS(".ABORTED*C*L")
	  /* JUST SET OF ALTERNATIVES AND SCORES. */
	  OUTS("ALTERNATIVES ");

	  FOR I=1 TO SPECIALPATS DO $(EachSpecial
			OUTS(FIRSTPATNAME!I); 
			OUTS(" "); 
			OUTNOS(PATSCORES!I) $)EachSpecial
         NEWLINE(1)
	 ENDCASE;
	CASE 4:
          if ABANDONED do OUTS(".ABORTED*C*L")
	       /* Have to output string showing Ion-composition used
		as basis of this alternatives type constraint.
	      */
	   OUTS("ION-COMPOSITION "); 
	   OUTS(KEYSTR); SPACES(1) 

	   FOR I=1 TO SPECIALPATS DO $(EachSpecial
			OUTS(FIRSTPATNAME!I); 
			OUTS(" "); 
			OUTNOS(PATSCORES!I) $)EachSpecial
           NEWLINE(1)
	   ENDCASE;
	DEFAULT:
  $)MDSW

 /* Rest of data in old top file, all substructure definitions etc,
 can just be copied.
 (Incidentally, copying old part of history list so most recently applied
 constraint appears first in history list)
 */

 COPYTOEND();
 ENDREAD(INPUT);
 INPUT:=TTY;
 ENDWRITE(OUTPUT);
 OUTPUT:=TTY
 NEWLINE(1)
$)nwtp


let CLOSEOUT() be $(cls
/* First must terminate the structure data in the temporary SC1 file
 by outputing final special '/' character.
*/

OUTPUT:=OUTFILE;
OUTCH(47);
OUTPUT:=TTY;
ENDWRITE(OUTFILE);

/* Results file now closed, if we had to create a random access file
 for canonicalization etc then this should be got rid of.
*/

UNLESS NOBUILD DO
 $(Canfl
 RANIOTERMINATE(SC2FILENAME(),CGEXT);
 DELETEFILE(SC2FILENAME(),CGEXT)
 PAGEREPORT()
 $)Canfl


REPORTTIMINGS()

/* Remember to close file of pre-existing cases (if any such file existed). */

IF STREXISTS DO ENDREAD(INFILE);

/* Now look at results, if didn't get any satisfactory structures then
 user has incorrectly expressed his constraints (or constraints inferred
 from spectral/chemical data were just wrong!).
 In such cases, best just leave him where he was before last constraint
 applied.
*/

IF NSTRUCS=0 DO
 $(null
 DELETEFILE(SC1FILENAME(),CGEXT);
 OUTS("*C*LTHERE SEEMS TO BE NO WAY TO SATISFY YOUR CONSTRAINT(S)*C*L");
 IF STREXISTS DO OUTS("THE ORIGINAL LIST HAS BEEN RESTORED*C*L");
 EXECUTERETURN()
 $)null

/* Get new top file contructed on temporary SC2 file. */

NEWTOP();

/* Get files updated, SC1 file contains new data to replace/become STR file,
 SC2 file is replacement of TOP,
 done with interrupts off so user can not break in and end up with
 an inconsistent TOP/STR file.
*/

INTERRUPTABLE(FALSE);
TEST STREXISTS THEN FILEREPLACE(STRFILENAME(),CGEXT,SC1FILENAME(),CGEXT)
               OR RENAMEFILE(SC1FILENAME(),CGEXT,STRFILENAME(),CGEXT);

FILEREPLACE(TOPFILENAME(),CGEXT,SC2FILENAME(),CGEXT);

/* Report on number of STRUCTURES/CASES produced. 
 (by convention, this done in interrupts off mode so report guaranteed
 even if ^c hit during/after file replacement) */

OUTNO(NSTRUCS);
TEST GENERATING THEN
 $(str
 OUTS((NSTRUCS=1 -> " STRUCTURE WAS"," STRUCTURES WERE"));
 OUTS(" GENERATED*C*L")
 $)str
OR
 $(cas
 OUTS((NSTRUCS=1 -> " CASE WAS"," CASES WERE"));
 OUTS(" OBTAINED*C*L")
 $)cas


INTERRUPTABLE(TRUE);

/* Final return depends on whether have just been adding another
 constraint or whether we were generating structures.
 If structures generated, then there is no point going back to
 GENOA so call one of structure processing programs (currently
 <congen>strchk.
*/

TEST GENERATING THEN
 $(trnsfr
 OUTS("TRANSFERRING CONTROL TO STRCHK...*C*L");
 if AROMWARN do 
	$(warn
	OUTS("*C*LThe AROMATIC character of your molecules has not yet been fully analyzed.")
	OUTS("*C*LOn starting in STRCHK you should define AROMATIC templates and")
	OUTS("*C*Lissue the AROMATIZE command.*C*L")
	$)warn
 STARTCGPART1(DNDPPN,"STRCHK")
 $)trnsfr
OR EXECUTERETURN()

$)cls


let SETUPBUILD() be $(SupBld
 /* Occassionally, when the constraint being applied is "xyz none", it
 is sufficient just to go through the existing CGPs checking that
 they are satisfactory.
 More typically, the constraint (or a request to "GENERATE" final
 structures) implies some construction with modification of atom
 properties and injection of new bonds. Then it is necessary to
 use the full canonicalization checks on each resulting structure
 and so need the random-access file of structure representations,
 need internal canonicalization tables initialized etc.

 Routine SETUPBUILD() does the extra initializiation necessary
 when it is possible that will build new bonds etc.

 a) finds number of words necessary to represent each structure
 in the canonical-table form (both internal and on random-access file)

 b) initializes the random access file.

 c) create a table of atom-properties that can be used for scoring
	CGP-nodes when finding the canonical representation of a CGP.
 
 */

 NOBUILD:=FALSE;

 /* Finding how many words will be necessary to represent structure,
 STRUCSZ0 is the number of "symbols" necessary (computed earlier
 in SETUP procedures, its a function of number of atoms, unsaturations
 etc), can get SYMSPERWD of these into each word.
 */

 STRUCSZ:=STRUCSZ0;
 IF [STRUCSZ REM SYMSPERWD] NE 0 DO STRUCSZ+:=SYMSPERWD;
 STRUCSZ:=STRUCSZ/SYMSPERWD;

 /* Initialization of internal canonicalization tables + random-access file. */

 EBPTR:=0;
 KEYLIST!SSSIZE:=PLUSINF;
 BLOCKCOUNT:=1;
 KFSTART:=SSSIZE;
 RANIOINIT(SC2FILENAME(),CGEXT);
 LASTBLOCK!0:=0;
 /* Now some trickery that just zeros out the first block in which
 canonical structures will be written (in core).
 */
 BLT(LASTBLOCK,LASTBLOCK+1,LASTBLOCK+BLKSIZE-1);

 /* If "building" structures, we need to make more use of symmetry
 on the CONGEN-PROBLEM-PART side (via ORBREP etc) and for that
 we have to create a canonical representation of each congen-problem-part
 Creation of the canonical representation implies some scoring according
 to atom node properties. Here we create an array of pointers to
 appropriate properties of the CGP atoms.
 This will be used, as "SCOREVEC" when in CANONCOMPS.

 */

 CGPATPROPS:=NEWVEC(7);
 CGPATPROPS!0:=7;
 CGPATPROPS!1:=ATFREQ;
 CGPATPROPS!2:=ATTYPE;
 CGPATPROPS!3:=ARTYPE;
 CGPATPROPS!4:=HMAX;
 CGPATPROPS!5:=HMIN
 CGPATPROPS!6:=HYBRIDTYPE
 CGPATPROPS!7:=UMARKS

$)SupBld


let OPENFDEFAT() be $(OPFD

 /* This function has to OPEN FILES and read the defintions of
 the atom-types being used and the composition of the structure
 being processed.

 1) STR file: 
	if just starting a problem there will be no
  STR file and we will be generating the initial cases.
  Otherwise, STR file is going to contain the cases on which we
  wish to impose further constraints.
 */

STREXISTS:=FILEEXISTS(STRFILENAME(),CGEXT);
IF STREXISTS DO INFILE:=FINDFILE("DSK",STRFILENAME(),CGEXT);

/* 2) SC1 file should contain the data on the new constraints etc. */
INPUT:=FINDFILE("DSK",SC1FILENAME(),CGEXT);
INSOURCE:=INPUT;
/* Read RETURN code identify program to which we return when all done. */

READRETURN();


/* 3) Find number of, names/valences of all standard atom types being
 used in this problem, allocated arrays etc.
*/

NTYPES:=INNO();
TYPENAME:=NEWVEC(NTYPES); 
TYPEVALENCE:=NEWVEC(NTYPES);
TYPENAME!0:="**"; /* The name "*" designates a tag on an atom for special handling in counting. */
TYPENUM:=NEWVEC(NTYPES);
FOR I=1 TO NTYPES DO
 $(Nmvlnc
 TYPENAME!I:=COPYS(INS());
 TYPEVALENCE!I:=INNO();
 TYPENUM!I:=0
 $)Nmvlnc

/* 4) Now pick up info that defines the composition/size of molecules
  etc. Code differs here according to whether we are starting a new
  problem (in which case get list of atoms+numbers, + seperately the
  number of hydrogens) or whether will be reading from an existing
  set of partially constructed structures when the corresponding
  data obtained from the STR file.
*/
TEST STREXISTS THEN
 $(
 INPUT:=INFILE;
 CGPSTOP:=INNO();
 INPUT:=INSOURCE
 $)
OR
 $(
 CGPSTOP:=0;
 FOR I=1 TO NTYPES DO $( TYPENUM!I:=INNO(); CGPSTOP+:=TYPENUM!I $);
 HCOUNT:=INNO();
 $);
CGPSTART:=1;
NNODES:=CGPSTOP
$)OPFD 



let FILLINCGP() be $(FLLNCGP
 /*  Fill in the first few entries of CTSTART/CTSTOP/ATTYPE etc
 with initial data defining the CONGEN-PROBLEM-PART. 
 Also compute size of structure so that will known how much space
 required to represent each in the canonical tables.
  CTPTR keeps track of size of CTABLE needed to represent CGP and is
 incremented appropriately according to the valence of each atom in
 the composition.
  STRUCSZ0 is a function of number of nodes + rings/double-bonds.

 */

CTPTR:=1; 
TEST STREXISTS THEN
 $(Oldproblem
 /* Working with existing CASES, can read relevant data from the STR
 file.
    Just getting atom-types and leaving space for connections appropriate
 to valence of each atom-type.
 */

 INPUT:=INFILE;
 U:=INNO();
 FOR I=1 TO CGPSTOP DO
  $(Ats
  ATI:=FINDTYPE(INS());
  ATTYPE!I:=ATI;
  CTPTR+:=TYPEVALENCE!ATI;
  TYPENUM!ATI+:=1
  $)Ats
 HCOUNT:=[CTPTR-1]-2*[U+CGPSTOP-1];
 INPUT:=INSOURCE
 $)Oldproblem
OR
 $(Newproblem
 CGPSTOP:=0;
 /* Simply initialise the CGP part of CTABLE with appropriate number
 of atoms of each type as given in the molecular formula.
    Slightly more initialization needed, since don't have any initial
 cases have to define complete CGP in terms of default atom properties
 like HYBRID = any, ARTYPE = any, HMIN = 0 etc

 */

 FOR I=1 TO NTYPES DO
  FOR J=1 TO TYPENUM!I DO
   $(
   CGPSTOP+:=1;
   ATTYPE!CGPSTOP:=I;				/* Set atom type. */
   ARTYPE!CGPSTOP:=3;				/* ARTYPE is either */
   HYBRIDTYPE!CGPSTOP:=15;			/* Hybridtype is any */
   HMIN!CGPSTOP:=0;				/* HMIN  is 0 */
   HMAX!CGPSTOP:=TYPEVALENCE!I-1;		/* HMAX is one less than valence */
   CTSTART!CGPSTOP:=CTPTR;			/* Pointers to start and end of NBRS list. */
   CTSTOP!CGPSTOP:=CTPTR-1;			
   CTPTR+:=TYPEVALENCE!I			/* Increment ptr to allow space for NBRs */
   $);
 IF CGPSTOP=1 DO HMAX!1+:=1;			/* Modify Max Hrange if problem is single atom!!!! */
 U:=1-CGPSTOP+[CTPTR-1-HCOUNT]/2		/* Compute unsaturation. */
 $)Newproblem

/* STRUCSZ0 gives number of SYMBOLS needed to represent each structure,
 there are 8 symbols/atom-node + extras for every multiple bond equivalent.
*/
STRUCSZ0:=10*CGPSTOP+2*[U-1]

/* TOTB0 gives the number of bonds that must be formed. */
TOTB0:=U+CGPSTOP-1
 ATFREQ:=NEWVEC(CGPSTOP)
 for I=1 to CGPSTOP do ATFREQ!I:=[TYPENUM![ATTYPE!I]]-CGPSTOP

/* Allocate couple of work arrays, easier to do this just once
rather than as needed.
*/
TEMPARS:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART
TEMPHYBS:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART

$)FLLNCGP 


let INITNODEVECTORS() be $(NTNDVS
/* Now know how many atom nodes are in the complete problem (CGP + all the
 current GLI items.
 So can allocated vectors of appropriate size and do any relevant initialization.

 HMIN		minimum Hs on node.
 HMAX		maximum Hs on node
 ARTYPE		code defining choice of aromatic types non-aromatic/aromatic/either (its a two bit bit-map)
 HYBRIDTYPE     code defining choice of "hybridization"
 UMARKS		uniqueness marks (not currently used, SEPT '80, use for COLOUR tags)

 SYMLIM		this only necessary for GLI-item nodes, it contains data
		relating to the symmetry of a GLI-item that can be used
		to minimize duplications when matching.
		(The address manipulation in its allocation is a way
		of getting SYMLIM[PATSTART::NNODES] type declaration).

 ATTYPE		atom type of a node.
 CTSTART/CTSTOP	pointers into CTABLE identifying neighbors of any given
		node
 
 MAPPEDTO	mapping data when establishing correspondence of 
		GLI and CGP nodes.


 */

HMIN:=NEWVEC(NNODES);
HMAX:=NEWVEC(NNODES);
ARTYPE:=NEWVEC(NNODES); 
FOR I=1 TO NNODES DO ARTYPE!I:=1;
HYBRIDTYPE:=NEWVEC(NNODES); 
FOR I=1 TO NNODES DO HYBRIDTYPE!I:=0;
UMARKS:=NEWVEC(NNODES); 
FOR I=1 TO NNODES DO UMARKS!I:=#7777;

PATSTART:=CGPSTOP+1;


SYMLIM:=NEWVEC(NNODES-PATSTART)-PATSTART;
FOR I=PATSTART TO NNODES DO SYMLIM!I:=0;

ATTYPE:=NEWVEC(NNODES);
CTSTART:=NEWVEC(NNODES);
CTSTOP:=NEWVEC(NNODES);
MAPPEDTO:=NEWVEC(NNODES); 
FOR I=1 TO NNODES DO MAPPEDTO!I:=0
/* SCRATCH VECTORS HMAX2 AND NDFREEV ARE USED IN PROCGLIMATCH.
 THERE DIDN'T SEEM TO BE ANY NEED FOR THEM TO BE ALLOCATED/DEALLOCATED
 ON EVERY ENTRY TO THAT ROUTINE SO I'VE MOVED THEM OUT HERE.
*/
HMAX2:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;
NDFREEV:=NEWVEC(CGPSTOP-CGPSTART)-CGPSTART;

$)NTNDVS


let INITPATVECSMODE() be $(IPVSMD
 /*  Need to allocate and initialize vectors pertaining to Patterns (GLI-items)
 that have to be considered and to determine the MODE for the program.

 Firstly, need to known the number of, and size of all patterns
 as this determines space that must be set aside.
*/

NUMPAT:=INNO();
PATNNDS:=NEWVEC(NUMPAT);
FOR I=1 TO NUMPAT DO $( 
	PATNNDS!I:=INNO(); 
	NNODES+:=PATNNDS!I $);

/*  Now need to know "MODE" program is running in,
 there are essentially four "MODEs"
   "0" = BLEACH --- go through structures, reset all colour tags on
	atoms to remove "colour" distinctions.
   "1" = GENERATE --- as it says, generate structures and pass them
    on to some program other than GENOA for further analysis.
   "2" = CONSTRAINT --- we have a single substructural constraint to
    apply, this will specify the number of instances of that substructure
    that must be constructed.
   "3" = ALTERNATIVE --- have a set of substructures, the constraint is
    essentially that there should exist at least one of these substructures
    in each of the cases that are produced.

   there are some additional MODEs that are all in fact special
   instances of ALTERNATIVE. These just require some extra data
   to be copied over to the "HISTORY" list of the TOP file to say
   something of the origin of that particular constraint.
   these extras include ION-COMPOSITION (in which case history list
   must record the composition of the ion used in formulating the
   constraint). These "MODEs" will have index numbers >3.

*/

MINGENERATESCORE:=MINUSINF
GENERATING,BLEACH:=FALSE,FALSE;
MODE:=INNO();

switchon MODE into $(sw
   case 0: BLEACH:=TRUE; endcase;
   case 1: GENERATING:=TRUE; 
	   /* Get a minimum score for required structures when generating. */
	   MINGENERATESCORE:=INNO()
	   endcase;
   case 2: FIRSTPATNAME:=COPYS(INS()); endcase;
   default:
	IF MODE>3 THEN $(Keystr
	  /* Special modes all have some key that should go into history list. */
	  KEYSTR:=COPYS(INS())
	  $)keystr


	 $(countspecial
  	/* when in any of the "alternatives" modes, will get a set
	of patterns to be processed. Find how many, create table for
	their names, scores and other data to go into history list. */

	  SPECIALPATS:=INNO();
	  FIRSTPATNAME:=NEWVEC(SPECIALPATS)
	  PATSCORES:=NEWVEC(SPECIALPATS);
	  FOR I=1 TO SPECIALPATS DO $(eachone
	    /* Read in names and associated "scores". 
		(these scores don't merely duplicate data we will get
		later when read actual connection tables
		because of problems re representation of -ve numbers
		in lists in GENOA, have scores offset by CFMAX). */
	    FIRSTPATNAME!I:=COPYS(INS());
	    PATSCORES!I:=INNO()
	    $)eachone
	 $)countspecial
$)sw
PATRECS:=NEWVEC(NUMPAT);
PATMINS:=NEWVEC(NUMPAT); 
PATMAXS:=NEWVEC(NUMPAT);
SUBSCORES:=NEWVEC(NUMPAT)


$)IPVSMD



let SETUP() be $(Sup
 /* This function allocates arrays, opens files etc.

 1) Call OPENFDEFAT() to open files and get atom defintions set up.

 */
 OPENFDEFAT()  

 /* 
 2) Call INITPATVECSMODE() to find number and size of patterns (GLI-items)
 allocate appropriate vectors etc, and to determine MODE for program
 (BLEACH, GENERATE, CONSTRAINT, ALTERNATIVE, etc)
 */
  
 INITPATVECSMODE() 


/* 
 3) Call INITNODEVECTORS() to allocate, and appropriately initialize
 all vectors pertaining to atom (node) properties. 
*/

INITNODEVECTORS();

/* 
 4) Call FILLINCGP() to get portion of CTSTART/CTSTOP/ATTYPE etc
 relating to CGP initialised with data on basic atom types etc.
*/
FILLINCGP();

/*
 5) Prepare for, then call READPATS to get the pattern definitions
 for the GLI-items read in, the connection tables are temporarily
 built up on STACK and are copied into CTABLE later.
*/

CTABLE:=STACK;
PATSTOP:=CGPSTOP;
 GSCRATCH!0:=GSIZE0
READPATS();
CTPTR-:=1;


/*
 6) Have finished with data in SC1 file so get rid of it. */

ENDREAD(INPUT);
DELETEFILE(SC1FILENAME(),CGEXT);

/* Have been building all the definitions of connection tables etc
 on the stack, get a CTABLE allocated and copy this initial data across.
*/

CTABLE:=NEWVEC(CTPTR);
BLT(STACK+1,CTABLE+1,CTABLE+CTPTR);

/* If we don't have to construct anything, because the minimum
 number needed for first pattern is zero, then much of the
 processing is simplified. Set NOBUILD flag to TRUE in such cases
 (obviously, if GENERATING then NOBUILD must be FALSE).
 If injecting SCORED ALTERNATIVES, and if all of them have -ve scores,
 then its not worth building anything, work with NOBUILD=TRUE
 but do apply scoring at the end.

 (The BLEACH command, MODE=0, requires full building mechanism set up
 as all it is in fact is a repeat of the case canonicalization procedure
 ignoring colors --- but that means must have random access file etc etc).

*/

NOBUILD:=FALSE; 
switchon MODE into $(MDSW
  CASE 0: CASE 1: SETUPBUILD(); ENDCASE;
  CASE 2: 
	test PATMINS!1=0 then NOBUILD:=TRUE
	or SETUPBUILD();
	ENDCASE;
  DEFAULT:
	test VALOF $(
	  /* return TRUE if effectively NOBUILD */
	  for ii=1 to SPECIALPATS do if SUBSCORES!ii GE 0 then resultis FALSE
	  resultis TRUE
	  $) then NOBUILD:=TRUE
	or SETUPBUILD()
 
 $)MDSW
/* Initialize counters. */
NSTRUCS:=0
ISTRUC:=0;
OLDBELIEF:=0;
OLDDISBELIEF:=0


$)Sup



let STARTSTRFL() be $(strf
/* Start the new structure file on SC1, write into it the
 number and type of atoms, unsaturation etc.
*/

OUTFILE:=CREATEFILE("DSK",SC1FILENAME(),CGEXT);
OUTPUT:=OUTFILE;
OUTNO(CGPSTOP);
SPACES(1);
OUTNOS(U);
FOR I=1 TO CGPSTOP DO $( OUTS(TYPENAME![ATTYPE!I]); SPACES(1) $);
OUTPUT:=TTY
$)strf


/* Main "DOSTUFF" program, 
 calls SETUP --- which reads data file with constraints etc building
 appropriate tables so everything available in core.
 calls STARTSTRFL --- which creates initial records in new "STR" file
 to which new CGPs will get written.
 then if have existing CONGEN-PROBLEM-PARTS(CGPS/CASES/partially constructued
 structures) want to work through each of these applying new constraints via
 INTERP, if just starting problem there are no existing entries and INTERP
 can just be applied to the atom-table (no connections) created during
 SETUP.
 finally,
 call CLOSEOUT to tidy up all the files and return to the calling program
 in the chained sequence of programs.
 */

SETUP()
COUNTPROCGLIMATCH:=0
COUNTUNIQUECGP:=0
COUNTFIND1:=0
COUNTFORMBONDS:=0
COUNTFINDBONDS:=0


STARTSTRFL()
COLLISIONCOUNT:=0; PAGING:=0;
FOR I=0 TO 20 DO TIMINGS!I:=0

ABANDONED:=FALSE
AROMWARN:=FALSE;
TEST STREXISTS 
	THEN WHILE FETCHCGP() DO $( 
		INTERP(); 
		CHECKUSERCONTROL(FALSE)
		if ABANDONED then break $)
	OR INTERP();
CLOSEOUT()

$)DOS;




/*
	This is the "main program" for GLBLD, of course it simply
consists of the calls to set up vector space for dynamic vector
handling (INITIALISEIO), default I/O, switch on recording mechanism
if appropriate (involves modifying address pointers to character
handling routines) and then calls the real processing program DOSTUFF.

*/

LET START() BE
 $(
 INITIALISEIO(VECSPACE, 20000);
 OUTPUT:=TTY;
 INPUT:=TTY;
 RECINIT();
 DOSTUFF()
 $)


